home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / 173c_bas.zip / SOURCE / RBBSSUB5.BAS < prev   
BASIC Source File  |  1991-09-01  |  100KB  |  3,006 lines
  1. ' $linesize:132
  2. ' $title: 'RBBSSUB5.BAS 17.3C, Copyright 1986 - 91 by D. Thomas Mack'
  3. '  Copyright 1991 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB5.BAS
  5. '  First Released .....: February 11, 1990
  6. '  Subsequent Releases.: August 26, 1990; October 28, 1990; Sept 1, 1991
  7. '  Copyright ..........: 1986 - 1991
  8. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  9. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  10. '     require error trapping are incorporated within RBBSSUB 2-5 as
  11. '     separately callable subroutines in order to free up as much
  12. '     code as possible within the 64K code segment used by RBBS-PC.BAS.
  13. '  Parameters..........: Most parameters are passed via a COMMON statement.
  14. '
  15. ' Subroutine  Line               Function of Subroutine
  16. '   Name     Number
  17. '  AraAllCaps     63720  Capitalize an elment of an array
  18. '  BinSearch      63520  Binary searches sorted file for a key value
  19. '  BreakFileName  63300  Break file name into component parts
  20. '  BufAsUnit      63500  Buffer out a string with CR's
  21. '  SetPrompt      63470  Set prompts based on the user's security
  22. '  DoorReturn     63100  Process door requests
  23. '  ExcludeCount   63715  Counts # of words in a string
  24. '  FdMacExe       63462  Executes a found macro
  25. '  FileSystem     20117  File System for RBBS-PC
  26. '  FindIt         63490  Check whether file exists and if so open as #2
  27. '  FormRead       63420  Read from file into a form
  28. '  LockAppend     63400  Prepare for a file append
  29. '  MacroExe       63460  Execute internal macro rather than user
  30. '  MsgNameMatch   63540  Match name to one in msg header
  31. '  NoPath         63480  Detects whether string has a path in it
  32. '  RestoreCom     63310  Restore comm port after external program
  33. '  ReadMacro      63330  Read and process macro
  34. '  ShellExit      63320  Exit RBBS via shell
  35. '  TakeOffHook    63530  Take modem off hook
  36. '  UnLockAppend   63410  Clean up after file append
  37. '  VerifyAns      63510  Verify that string passes edits
  38. '  WildCard       63200  Match string to a pattern
  39. '
  40. '  $INCLUDE: 'RBBS-VAR.BAS'
  41. '
  42. 20117 ' $SUBTITLE: 'FileSystem -- subroutine for RBBS-PC's file system'
  43. ' $PAGE
  44. '
  45. ' NAME    -- FileSystem
  46. '
  47. ' INPUTS  --       PARAMETER                 MEANING
  48. '             ZFileSysParm = 1  LIST THE SYSOP'S COMMENTS FILE
  49. '                                 2  L)IST DIRECTORY COMMAND
  50. '                                 3  D)OWNLOAD COMMAND
  51. '                                 4  RETURN FROM EXTERNAL PROTOCOLS
  52. '                                 5  U)PLOAD COMMAND
  53. '                                 6  S)CAN DIRECTORY COMMAND
  54. '                                 7  P)ERSONAL FILES COMMAND
  55. '                                 8  N)EW FILES COMMAND
  56. '                                 9  RETURN FROM EXTENDED DESCRIPTION
  57. '
  58. ' OUTPUTS -- ZFileSysParm = 1  COMMAND PROCESSED SUCCESSFULLY
  59. '                                2  RECYCLE TO TOP OF RBBS-PC (202)
  60. '                                3  PROCESS NEXT COMMAND (1200)
  61. '                                4  DENY USER ACCESS (1380)
  62. '                                5  HANDLE EXTENDED DESCRIP. (2008)
  63. '                                6  USER'S TIME EXCEEDED (10553)
  64. '                                7  Carrier DROPPED (10595)
  65. '
  66. ' PURPOSE -- To handle the RBBS-PC file system commands
  67. '
  68.       SUB FileSystem STATIC
  69.       ZFF = ZFileSysParm
  70.       ZFileSysParm = 1
  71.       ON ZFF GOSUB 20119, _  ' HANDLER TO LIST COMMENTS TO SYSOP
  72.                   20150, _  ' L)IST DIRECTORY COMMAND HANDLER
  73.                   20180, _  ' D)OWNLOAD COMMAND HANDLER
  74.                   20263, _  ' RETURN FROM EXTERNAL Protocol'S
  75.                   20400, _  ' U)PLOAD COMMAND HANDLER
  76.                   21800, _  ' S)CAN DIRECTORY COMMAND HANDLER
  77.                   21850, _  ' P)ERSONAL FILES COMMAND HANDLER
  78.                   21860, _  ' N)EW FILES COMMAND HANDLER
  79.                   20705     ' RETURN FROM EXTENDED DESCRIPTIONS
  80.       GOTO 21920
  81. 20119 ZErrCode = 0
  82.       GOTO 20122
  83. '
  84. ' *****  SCAN DIRECTORIES (PRINT TEXT)  ****
  85. '
  86. '  (formerly lines 7000 to 7260 in RBBS-PC.BAS CPC16-1A
  87. 20120 ZOutTxt$ = "Scanning Directory " + _
  88.            ZFileNameHold$
  89.       IF WasRS$ <> "" THEN _
  90.          ZOutTxt$ = ZOutTxt$ + " for " + WasRS$
  91.       GOSUB 21650
  92.       IF ZFileSysParm > 1 THEN _
  93.          RETURN
  94.       CALL AskMore ("",ZTrue,ZTrue,ZAnsIndex,ZFalse)
  95.       IF ZNo THEN _
  96.          ZErrCode = 0 : _
  97.          RETURN
  98.       WasPG = ZTrue
  99. 20122 CALL OpenWork (2,ZFileName$)
  100.       IF ZErrCode = 53 THEN _
  101.          ZOutTxt$ = "Missing File " + ZFileName$ : _
  102.          CALL UpdtCalr (ZOutTxt$,2) : _
  103.          ZOutTxt$ = ZOutTxt$ + _
  104.               ". Please tell SysOp" : _
  105.          GOSUB 21650 : _
  106.          RETURN
  107.       ZJumpSupported = ZTrue
  108.       ZJumpLast$ = ""
  109.       LastOK = ZFalse
  110.       ZJumpSearching = ZFalse
  111. 20124 CALL Carrier
  112.       IF EOF(2) OR _
  113.          (ZSubParm = -1 AND NOT ZLocalUser) THEN _
  114.          GOTO 20142
  115. 20126 CALL ReadDir (2,1)
  116.       IF ZErrCode <> 0 THEN _
  117.          ZWasEL = 20126 : _
  118.          GOTO 21900
  119.       IF LEFT$(ZOutTxt$,1) = " " THEN _
  120.          IF LastOK AND NOT ZExtendedOff THEN _
  121.             GOTO 20140 _
  122.          ELSE GOTO 20124
  123.       IF WasCK = 0 THEN _
  124.          GOTO 20140
  125.       LastOK = ZFalse
  126. 20128 IF ZJumpSearching THEN _
  127.          GOTO 20129
  128.       IF WasCK < 2 THEN _
  129.          GOTO 20130
  130.       IF WildSearch THEN _
  131.          ZWasA = INSTR(ZOutTxt$," ") : _
  132.          IF ZWasA = 0 THEN _
  133.             GOTO 20124 _
  134.          ELSE ZWasZ$ = LEFT$(ZOutTxt$,ZWasA - 1) : _
  135.               CALL WildFile (WasRS$,ZWasZ$,WasXXX) : _
  136.               WasXXX = NOT WasXXX : _
  137.               GOTO 20136
  138. 20129 ZWasZ$ = ZOutTxt$
  139.       CALL AllCaps (ZWasZ$)
  140.       WasXXX = (INSTR(ZWasZ$,WasRS$) = 0)
  141.       GOTO 20136
  142. 20130 ZWasA = INSTR(9,MID$(ZOutTxt$,1,32),"/")
  143.       IF ZWasA = 0 THEN _
  144.          ZWasA = INSTR(9,MID$(ZOutTxt$,1,32),"-")
  145. 20132 IF ZWasA < 3 THEN _
  146.          GOTO 20124
  147.       IF INSTR("0123456789",MID$(ZOutTxt$,ZWasA - 1,1)) = 0 THEN _
  148.          GOTO 20124
  149.       ZWasA = ZWasA - 2
  150.       WasWK$ = RIGHT$(MID$(ZOutTxt$,ZWasA,8),2) + _
  151.             LEFT$(MID$(ZOutTxt$,ZWasA,8),2) + _
  152.             MID$(MID$(ZOutTxt$,ZWasA,8),4,2)
  153.       IF MID$(WasWK$,3,1) = " " THEN _
  154.          MID$(WasWK$,3,1) = "0"
  155.       IF MID$(WasWK$,5,1) = " " THEN _
  156.          MID$(WasWK$,5,1) = "0"
  157. 20134 WasXXX = (WasWK$ < WasRS$)
  158. 20136 IF WasXXX THEN _
  159.          GOTO 20124
  160.       IF ZJumpSearching THEN _
  161.          WasRS$ = PrevSearch$ : _
  162.          WasCK = PrevCK : _
  163.          ZJumpSearching = ZFalse : _
  164.          GOTO 20140
  165.       IF WasPG THEN _
  166.          WasPG = ZFalse : _
  167.          CALL OpenWork (2,ZFileName$) : _
  168.          ZWasQ = 0 : _
  169.          GOTO 20124
  170. 20138 IF WasPG THEN _
  171.          GOTO 20124
  172. 20140 LastOK = ZTrue
  173.       GOSUB 21650
  174.       IF ZFileSysParm > 1 THEN _
  175.          RETURN
  176.       CALL AskMore ("",ZTrue,ZTrue,ZAnsIndex,ZFalse)
  177.       IF ZNo THEN _
  178.          ZErrCode = 0 : _
  179.          RETURN
  180.       IF ZJumpSearching THEN _
  181.          IF LEFT$(ZOutTxt$,1) <> " " THEN _
  182.             PrevSearch$ = WasRS$ : _
  183.             PrevCK = WasCK : _
  184.             WasCK = 2 : _
  185.             WasRS$ = ZJumpTo$
  186.       IF NOT ZRet THEN _
  187.          GOTO 20124
  188. 20142 ZWasQ = 0
  189.       ZJumpSupported = ZFalse
  190.       CLOSE 2
  191.       CALL Carrier
  192.       IF ZSubParm = -1 THEN _
  193.          ZFileSysParm = 7
  194.       RETURN
  195. '
  196. ' *  L - COMMAND FROM FILES MENU (LIST DIRECTORY)
  197. '
  198. 20150 ZListDir = ZTrue
  199.       ListNew = ZFalse
  200.       SearchDate$ = ""
  201.       SearchString$ = ""
  202.       WasRS$ = ""
  203.       ShowDirOfDir = (ZLastIndex <= ZAnsIndex) AND NOT ZExpertUser
  204.       WasCK = 0
  205.       ZSearchingAll = ZFalse
  206.       ZExtendedOff = ZFalse
  207. 20155 IF ListNew OR ZAnsIndex > 255 THEN _
  208.          RETURN
  209.       CALL GetDirs (ShowDirOfDir)
  210.       IF ZWasQ = 0 THEN _
  211.          RETURN
  212.       ShowDirOfDir = ZFalse
  213.       CALL ConvertDir (ZAnsIndex)
  214.       WasQX = ZLastIndex
  215. 20157 CALL Carrier
  216.       IF ZSubParm = -1 THEN _
  217.          ZFileSysParm = 7 : _
  218.          RETURN
  219.       GOTO 20161
  220. 20159 IF ZAnsIndex < ZLastIndex THEN _
  221.          GOTO 20155
  222.       ZSearchingAll = ZFalse
  223.       CALL CmdStackPushPop (1)
  224.       ZLastIndex = 0
  225.       IF ZNo OR (ZFileNameHold$ = ZDirPrefix$) THEN _
  226.          GOTO 20155
  227.       GOSUB 20178
  228.       CALL QuickTPut (ZEmphasizeOff$,0)
  229.       ZOutTxt$ = "End list.  L)ist, [Q]uit, or file(s) to dwnld"
  230.       ZStackC = ZTrue
  231.       GOSUB 21668
  232.       CALL AraAllCaps (ZUserIn$(),1)
  233.       IF ZUserIn$(1) = "L" THEN _
  234.          ZUserIn$(ZAnsIndex) = WasA1$ : _
  235.          GOTO 20161
  236.       IF LEN(ZUserIn$(1)) > 1 AND _
  237.          ZUserSecLevel >= ZOptSec(19 - 20 * (ZMenuIndex = 6)) THEN _
  238.          ZAnsIndex = 1 : _
  239.          GOSUB 20202
  240.       CALL CmdStackPushPop (2)
  241.       RETURN
  242. 20161 IF INSTR(ZUserIn$(ZAnsIndex),".") THEN _
  243.          GOTO 20172
  244.       ZViolation$ = "List Dir. "
  245.       ZWasZ$ = ZUserIn$(ZAnsIndex)
  246.       ZWasA = INSTR("E+E-E",ZWasZ$)
  247.       IF ZWasA > 0 THEN _
  248.          IF ZWasA = 5 THEN _
  249.             ZExtendedOff = NOT ZExtendedOff : _
  250.             GOTO 20155 _
  251.          ELSE ZExtendedOff = (ZWasA > 2) : _
  252.               GOTO 20155
  253.       CALL AllCaps(ZWasZ$)
  254.       ZFileNameHold$ = ZWasZ$
  255.       WasA1$ = ZWasZ$
  256.       IF ZWasZ$ = ZDirPrefix$ THEN _
  257.          GOTO 20164
  258.       InFMS = ZFalse
  259. 20162 CALL CmdStackPushPop (1)         ' save dir list list processing
  260.       CALL FMS (ZWasZ$,SearchString$,SearchDate$,InFMS, _
  261.                 ZCategoryName$(),ZCategoryCode$(),ZCategoryDesc$(),_
  262.                 DnldFlag,CatFound,ZAnsIndex)
  263.       WHILE DnldFlag > 0 AND ZSubParm > -1
  264.          GOSUB 20202
  265.          IF ZFileSysParm > 1 THEN _
  266.             RETURN
  267.          WasX$ = ZCategoryCode$(CatFound)
  268.          CALL DispUpDir (WasX$,SearchString$,SearchDate$,DnldFlag,ZAnsIndex)
  269.          CALL CheckTimeRemain (MinsRemaining)
  270.          IF ZSubParm = -1 THEN _
  271.             ZFileSysParm = 6 : _
  272.             RETURN
  273.          CALL Carrier
  274.       WEND
  275.       IF ZSubParm = -1 THEN _
  276.          ZFileSysParm = 7 : _
  277.          RETURN
  278.       IF ZAnsIndex > 255 THEN _
  279.          ZLastIndex = 0 : _
  280.          RETURN
  281.       CALL CmdStackPushPop (2)        ' restore dir list list processing
  282.       ZActiveFMSDir$ = ""
  283.       IF InFMS THEN _
  284.          GOTO 20159
  285.       IF ZUserSecLevel < ZMinSecToView THEN _
  286.          IF ZFileNameHold$ = ZUpldDirCheck$ THEN _
  287.             ZFileNameHold$ = "of uploads" : _
  288.             GOTO 20172
  289.       ZFileNameHold$ = ZUserIn$(ZAnsIndex)
  290.       IF ZLimitSearchToFMS THEN _
  291.          GOTO 20166
  292.       IF NOT ZSearchingAll THEN _
  293.          IF ZFileNameHold$ = "ALL" OR ZFileNameHold$ = "A" THEN _
  294.             ZSearchingAll = ZTrue : _
  295.             GOSUB 21890 : _
  296.             GOTO 20157
  297.       CALL BadFile (ZFileNameHold$,BadFileNameIndex)
  298.       ON BadFileNameIndex GOTO 20163,20172,20176
  299. 20163 ZFileName$ = ZFileNameHold$
  300.       CALL BadName (BadFileNameIndex,ZTrue)
  301.       ON BadFileNameIndex GOTO 20164,20176
  302. 20164 IF ZFileName$ = ZUpldDirCheck$ AND _
  303.          ZUserSecLevel >= ZMinSecToView THEN _
  304.             ZFileName$ = ZUpldPath$ _
  305.       ELSE ZFileName$ = ZCurDirPath$
  306.       ZFileName$ = ZFileName$ + _
  307.                    ZFileNameHold$ + _
  308.                    "." + _
  309.                    ZDirExtension$
  310.       CALL Graphic (ZUserGraphicDefault$,ZFileName$)
  311. 20165 IF ZOK THEN _
  312.          CALL ReadDir (2,1) : _
  313.          IF ZErrCode = 0 THEN _
  314.             IF LEFT$(ZOutTxt$,4) = "\FMS" THEN _
  315.                InFMS = ZTrue : _
  316.                ZActiveFMSDir$ = ZFileName$ : _
  317.                GOTO 20162 _
  318.             ELSE GOTO 20167
  319. 20166 ZFileName$ = ZCurDirPath$ + _
  320.                    ZFileNameHold$ + ".MNU"
  321.       CALL FindIt (ZFileName$)
  322.       IF ZOK THEN _
  323.          CALL BufFile (ZFileName$,ZAnsIndex) : _
  324.          GOTO 20155
  325.       IF ZAltdirExtension$ = "" THEN _
  326.          GOTO 20172
  327.       ZFileName$ = ZCurDirPath$ + _
  328.                    ZFileNameHold$ + _
  329.                    "." + _
  330.                    ZAltdirExtension$
  331.       CALL Graphic (ZUserGraphicDefault$,ZFileName$)
  332.       IF NOT ZOK THEN _
  333.          GOTO 20172
  334. 20167 ZUserIn$(0) = ZUserIn$(ZAnsIndex)
  335.       GOSUB 20120
  336.       IF ZFileSysParm > 1 THEN _
  337.          RETURN
  338.       GOTO 20170
  339. 20168 CALL BufFile(ZFileName$,ZAnsIndex)
  340.       CALL Carrier
  341.       IF ZSubParm = -1 THEN _
  342.          ZFileSysParm = 7 : _
  343.          RETURN
  344. 20170 IF ZAnsIndex > 255 THEN _
  345.          ZLastIndex = 0 : _
  346.          RETURN
  347.       ZUserIn$(ZAnsIndex) = ZUserIn$(0)
  348.       GOTO 20159
  349. 20172 IF NOT ZSearchingAll THEN _
  350.          ZOutTxt$ = "Directory " + _
  351.               ZFileNameHold$ + _
  352.               " not found!" : _
  353.          GOSUB 21640 : _
  354.          ZNo = ZTrue : _
  355.          IF ZFileSysParm > 1 THEN _
  356.             RETURN
  357.       GOTO 20155
  358. 20176 CALL SecViolation
  359.       IF ZDenyAccess THEN _
  360.          ZFileSysParm = 4 : _
  361.          RETURN
  362.       GOTO 20172
  363. '
  364. ' *  D - COMMAND FROM FILES MENU (SEARCH FOR FILE TO DOWNLOAD)
  365. '
  366. 20178 ZListOnly = ZFalse
  367.       ZExtraDnldTime = 0
  368.       ZFreeDnld = ZFalse
  369.       ZPersonalDnld = ZFalse
  370.       RETURN
  371.  
  372. 20180 ZOutTxt$ = "Download what file(s)"
  373.       GOSUB 20178
  374.       ZStackC = ZTrue
  375.       GOSUB 21668
  376.       IF ZFileSysParm > 1 THEN _
  377.          RETURN
  378.       IF ZWasQ = 0 THEN _
  379.          RETURN
  380. 20202 IF (ZTimeLock AND 2) AND (NOT TimeLockExempt) AND NOT ZHasPrivDoor THEN _
  381.          CALL TimeLock : _
  382.          IF NOT ZOK THEN _
  383.             RETURN
  384.       LastDnld = ZLastIndex
  385.       FirstDnld = ZAnsIndex
  386.       ZCmdTransfer$ = ""
  387.       IF ZAutoDownYes THEN _
  388.          ZCmdTransfer$ = "X"
  389.       ZAutoDownInProgress = ZAutoDownYes
  390.       ZAnsIndex = ZLastIndex
  391.       GOSUB 20470
  392.       LastDnld = LastDnld + (WasX > 0)
  393.       BatchBytes# = 0
  394.       BatchBlocks# = 0
  395.       ZDownFiles = 0
  396.       CALL KillWork (ZNodeWorkFile$)
  397.       ZErrCode = 0
  398.       FOR ZAnsIndex = FirstDnld TO LastDnld
  399.          GOSUB 20470
  400.          GOSUB 20205
  401.          ZCmdTransfer$ = ZWasFT$
  402.          CALL Line25
  403.          IF ZFileSysParm > 1 OR ZInternalProt$ = "N" THEN _
  404.             ZAnsIndex = LastDnld + 1
  405. 20203 NEXT
  406.       ZLastIndex = 0
  407.       IF ZFileSysParm > 1 THEN _
  408.          RETURN
  409.       ZBatchTransfer = ZFalse
  410.       ZCmdTransfer$ = ""
  411.       RETURN
  412. 20205 MarkingTime = (ZAnsIndex = FirstDnld OR NOT ZConcatFIles)
  413.       ZFileName$ = ZUserIn$(ZAnsIndex)
  414.       CALL Remove (ZFileName$,", ")
  415.       ZViolation$ = "Download "
  416.       IF PersonalDnld THEN _
  417.          CALL BreakFileName (ZFileName$,DR$,ZWasY$,WasX$,ZTrue) : _
  418.          ZFileNameHold$ = ZWasY$ + _
  419.                            WasX$ : _
  420.          GOTO 20235
  421.       ZFileNameHold$ = ZFileName$
  422.       CALL BadFile (ZFileName$,BadFileNameIndex)
  423.       ON BadFileNameIndex GOTO 20220,20231,20233
  424. 20220 IF INSTR (ZFileName$,".") = 0 THEN _
  425.          FileNameAlt$ = ZFileName$ : _
  426.          ZFileName$ = ZFileName$ + "." + ZDefaultExtension$ : _
  427.          ZFileNameHold$ = ZFileNameHold$ + "." + ZDefaultExtension$ _
  428.       ELSE FileNameAlt$ = ""
  429. 20222 CALL RotorsDir (ZFileName$,ZSubDir$(),ZSubDirCount + _
  430.                       ((ZUserSecLevel < ZMinSecToView) OR _
  431.                        NOT ZCanDnldFromUp),MarkingTime,"D")
  432. 20225 IF ZOK THEN _
  433.          GOTO 20235
  434.       IF ZDotFlag THEN _
  435.          RETURN
  436.       IF FileNameAlt$ <> "" THEN _
  437.          ZFileName$ = FileNameAlt$ : _
  438.          FileNameAlt$ = "" : _
  439.          ZFileNameHold$ = ZFileName$ : _
  440.          GOTO 20222
  441. 20231 ZOutTxt$ = ZFileNameHold$ + _
  442.            " not found!"
  443.       CALL UpdtCalr (ZOutTxt$,2)
  444.       IF ZAutoDownInProgress THEN _
  445.          ZOutTxt$ = ZOutTxt$ + _
  446.               " during AUTODOWNLOAD" : _
  447.          GOSUB 21640 : _
  448.          RETURN
  449.       ZOutTxt$ = ZOutTxt$ + _
  450.            " Correct name"+ZPressEnterExpert$
  451.       ZSuspendAutoLogoff = ZTrue
  452.       GOSUB 21660
  453.       ZSuspendAutoLogoff = ZFalse
  454.       IF ZFileSysParm > 1 THEN _
  455.          RETURN
  456.       IF ZWasQ=0 THEN _
  457.          IF ZBatchTransfer AND ZAnsIndex >= LastDnld THEN _
  458.             GOTO 20262 _
  459.          ELSE ZAutoLogOffReq = ZFalse : _
  460.               RETURN
  461.       ZUserIn$(ZAnsIndex) = ZUserIn$(1)
  462.       GOTO 20205
  463. 20233 CALL SecViolation
  464.       IF ZDenyAccess THEN _
  465.          ZFileSysParm = 4 : _
  466.          RETURN
  467.       GOTO 20231
  468. 20235 CALL BadName (BadFileNameIndex,ZTrue)
  469.       ON BadFileNameIndex GOTO  20236,20245
  470. 20236 ZLine25$ = "(D) " + _
  471.                  ZWasZ$
  472.       IF ZAutoDownInProgress THEN _
  473.          MID$(ZLine25$,2,1) = "A"
  474. '
  475. ' *  TEST FOR DOWNLOAD SECURITY
  476. '
  477.       CALL OpenWork (2,ZFileSecFile$)
  478.       IF ZErrCode = 53 THEN _
  479.          CALL UpdtCalr ("Missing file " + ZFileSecFile$,2) : _
  480.          GOTO 20247
  481. 20242 IF EOF(2) THEN _
  482.          GOTO 20247
  483.       CALL ReadParms (ZWorkAra$(),3,1)
  484.       IF ZErrCode <> 0 THEN _
  485.          ZWasEL = 20242 : _
  486.          GOTO 21900
  487. 20243 CALL WildFile (ZWorkAra$(1),ZWasZ$,ZOK)
  488.       IF NOT ZOK THEN _
  489.          GOTO 20242
  490. 20244 IF ZUserSecLevel < VAL(ZWorkAra$(2)) THEN _
  491.          GOTO 20245
  492.       FilePswd$ = ZWorkAra$(3)
  493.       IF FilePswd$ = "" THEN _
  494.          GOTO 20247
  495.       CALL AllCaps (FilePswd$)
  496.       IF FilePswd$ = ZPswd$ THEN _
  497.          GOTO 20247
  498.       ZOutTxt$ = "Enter PASSWORD to download " + _
  499.            ZFileName$
  500.       GOSUB 21660
  501.       IF ZFileSysParm > 1 THEN _
  502.          RETURN
  503.       IF ZWasQ = 0 THEN _
  504.          RETURN
  505.       CALL AraAllCaps (ZUserIn$(),1)
  506.       IF ZUserIn$(1) = FilePswd$ THEN _
  507.          GOTO 20247
  508. 20245 ZViolation$ = "DownLoad " + _
  509.                    ZFileName$
  510. 20246 CALL SecViolation
  511.       IF ZDenyAccess THEN _
  512.          ZFileSysParm = 4
  513.       RETURN
  514. 20247 ZWasDF = 0
  515.       CALL BreakFileName (ZFileName$,DR$,WasX$,Extension$,ZFalse)
  516.       IF ZAutoDownInProgress THEN _
  517.          ZUserIn$(ZAnsIndex) = WasX$ + "." + Extension$ : _
  518.          ZOutTxt$ = "Transferring -- " + _
  519.               ZUserIn$(ZAnsIndex) : _
  520.          GOSUB 21640 : _
  521.          IF ZFileSysParm > 1 THEN _
  522.             RETURN
  523.       IF INSTR("...WRK.FW .ARC.EXE.COM.OBJ.WKS.LBR.ZIP.PAK.ZOO.LZH.","."+Extension$+".") > 2 OR _
  524.          MID$(Extension$,2,1) = "Q" OR _
  525.          (ZRequireNonASCII AND Extension$ = "BAS") THEN _
  526.             ZWasDF = ZTrue
  527. 20248 ZOutTxt$ = ""
  528.       IF ZBatchTransfer THEN _
  529.          IF ZAnsIndex < LastDnld THEN _
  530.             GOTO 20260
  531.       CALL XferType (2,ZTrue)
  532.       IF ZFF THEN _
  533.          GOTO 20260
  534.       CALL XferType (1,ZTrue)
  535.       IF ZSubParm = -1 THEN _
  536.          ZFileSysParm = 7 : _
  537.          RETURN
  538. 20260 ZTransferFunction = 1
  539.       GOSUB 21790
  540.       IF ZFileSysParm > 1 THEN _
  541.          RETURN
  542.       ZBatchTransfer = (ZBatchProto AND (LastDnld > FirstDnld))
  543.       IF ZBatchTransfer AND ZCmdTransfer$ = "" THEN _
  544.          ZCmdTransfer$ = ZWasFT$
  545.       ON INSTR("AXCYN",ZInternalProt$) GOTO _
  546.          20340, _              ' ASCII DOWNLOAD
  547.          20290, _              ' Xmodem
  548.          20290, _              ' Xmodem CRC
  549.          20270, _              ' YMODEM
  550.          21700                 ' NONE - CANCEL
  551. '
  552. ' *  EXTERNAL Protocol Downloads/Uploads
  553. '
  554. 20261 IF ZReq8Bit THEN _
  555.          IF NOT ZEightBit THEN _
  556.             GOSUB 20318 : _
  557.             IF ZFileSysParm > 1 THEN _
  558.                RETURN _
  559.             ELSE GOSUB 20992 : _
  560.                  IF ZFileSysParm > 1 THEN _
  561.                     RETURN
  562.       IF ZTransferFunction = 1 THEN _
  563.          GOSUB 20750 : _
  564.          CLOSE 2 : _
  565.          IF ZFileSysParm > 1 OR NOT ZOK THEN _
  566.             RETURN
  567. 20262 IF ZBatchTransfer THEN _
  568.          IF ZAnsIndex < LastDnld THEN _
  569.             RETURN _
  570.          ELSE ZBlocksInFile# = BatchBlocks# : _
  571.               ZBytesInFile# = BatchBytes# : _
  572.               ZNumDnldBytes! = BatchBytes# : _
  573.               IF ZBytesInFile# < 1 THEN _
  574.                  RETURN _
  575.               ELSE GOSUB 20780 : _
  576.                    IF ZFileSysParm > 1 OR NOT ZOK THEN _
  577.                       RETURN
  578.       IF ZAutoDownInProgress THEN _
  579.          CALL SendName : _
  580.          IF ZAbort THEN _
  581.             DnldCompleted = ZFalse : _
  582.             GOSUB 21760 : _
  583.             RETURN
  584.       GOSUB 20337
  585.       CALL Transfer
  586. 20263 IF ZPrivateDoor THEN _
  587.          ZCmdTransfer$ = ZWasFT$ : _
  588.          CALL XferType (2,ZTrue) : _
  589.          ZCmdTransfer$ = ""
  590.       CALL OpenWork (2,"XFER-" + ZNodeID$ + ".DEF")
  591.       IF ZErrCode <> 0 THEN _
  592.          GOTO 20267
  593.       CALL ReadParms (ZWorkAra$(), ZFailureParm, 1)
  594.       IF ZErrCode <> 0 THEN _
  595.          GOTO 20267
  596.       CLOSE 2
  597.       CALL KillWork ("XFER-" + ZNodeID$ + ".DEF")
  598. 20264 IF ZPrivateDoor THEN _
  599.          ZFileName$ = ZWorkAra$(1) : _
  600.          CALL BreakFileName (ZFileName$,WasX$,ZFileNameHold$,ZWasY$,ZTrue) : _
  601.          ZFileNameHold$ = ZFileNameHold$ + _
  602.                            ZWasY$
  603.       IF LEFT$(ZWorkAra$(ZFailureParm),1) = "L" THEN _
  604.          MID$(ZWorkAra$(ZFailureParm),1,1) = ZFailureString$
  605. 20265 IF ZTransferFunction = 2 THEN _
  606.          IF INSTR(ZWorkAra$(ZFailureParm),ZFailureString$) <> 1 THEN _
  607.             GOTO 20700 _
  608.          ELSE GOTO 20730
  609.       IF ZTransferFunction = 1 THEN _
  610.          DnldCompleted = (INSTR(ZWorkAra$(ZFailureParm),ZFailureString$) <> 1)
  611.       GOSUB 21760
  612.       CALL Carrier
  613.       IF ZSubParm = -1 THEN _
  614.          ZFileSysParm = 7
  615.       RETURN
  616. '
  617. ' *  XFER FILE NOT Found
  618. '
  619. 20267 ZWasEL = 20263
  620.       GOTO 21900
  621.  
  622. '
  623. ' *  YMODEM DOWNLOAD DRIVER
  624. '
  625. 20270 GOTO 20292
  626. '
  627. ' *  Xmodem DOWNLOAD DRIVER
  628. '
  629. 20290 '
  630. 20292 GOSUB 20750
  631.       IF ZFileSysParm > 1 OR NOT ZOK THEN _
  632.          RETURN
  633.       WasA1$ = "SEND"
  634.       GOSUB 20320
  635.       IF ZFileSysParm > 1 THEN _
  636.          RETURN
  637.       IF ZLocalUser THEN _
  638.          CALL QuickTPut1 ("Protocol not available in local mode") : _
  639.          RETURN
  640.       IF ZAutoDownInProgress THEN _
  641.          GOSUB 20294 : _
  642.          IF ZAbort THEN _
  643.             RETURN
  644.       GOSUB 21300
  645.       IF ZFileSysParm > 1 THEN _
  646.          RETURN
  647.       ZOutTxt$ = ""
  648.       GOTO 20390
  649. 20294 CALL SendName
  650.       RETURN
  651. 20318 ZOutTxt$ = "Please Switch to N,8,1 for binary transfer"
  652.       GOSUB 21630
  653.       IF ZFileSysParm > 1 THEN _
  654.          RETURN
  655.       CALL DelayTime (3)
  656.       RETURN
  657. 20320 IF NOT ZEightBit THEN _
  658.          GOSUB 20318 : _
  659.          IF ZFileSysParm > 1 THEN _
  660.             RETURN
  661. 20325 IF ZCheckSum THEN _
  662.          ZNAK$ = CHR$(21) : _
  663.          SOL = 132 _
  664.       ELSE ZNAK$ = "C" : _
  665.            SOL = 133
  666. 20330 IF ZAutoDownInProgress THEN _
  667.          RETURN
  668.       GOSUB 20337
  669.       ZOutTxt$ = ZProtoPrompt$ + _
  670.             " " + WasA1$ + _
  671.             " of " + _
  672.             ZFileNameHold$ + _
  673.             " ready.  <Ctrl X> aborts"
  674.       GOSUB 21650
  675. 20335 IF ZTransferFunction = 1 THEN _
  676.          CALL Talk (8,ZOutTxt$) _
  677.       ELSE CALL Talk (9,ZOutTxt$)
  678.       RETURN
  679. 20337 IF ZProtoMacro$ <> "" THEN _
  680.          ZGSRAra$(1) = MID$("DU ",ZTransferFunction,1) : _
  681.          CALL MacroExe (ZProtoMacro$)
  682.       RETURN
  683. '
  684. ' *  ASCII DOWNLOAD DRIVER
  685. '
  686. 20340 IF ZWasDF THEN _
  687.          ZOutTxt$ = "Switch to a non-ascii protocol" : _
  688.          GOSUB 21650 : _
  689.          GOTO 21700
  690.       GOSUB 20750
  691.       IF ZFileSysParm > 1 OR NOT ZOK THEN _
  692.          RETURN
  693.       CALL OpenWork (2,ZFileName$)
  694.       IF (ZAnsIndex = FirstDnld OR NOT ZConcatFIles) THEN _
  695.          GOSUB 20337 : _
  696.          ZOutTxt$ = "^X aborts.  ^S suspends ^Q resumes" : _
  697.          GOSUB 21640 : _
  698.          IF ZFileSysParm > 1 THEN _
  699.             RETURN _
  700.          ELSE ZOutTxt$ = ZProtoPrompt$ + " SEND of " + _
  701.               ZFileNameHold$ + _
  702.               " ready. Press Any Key to start" : _
  703.          ZTurboKey = 2 : _
  704.          ZForceKeyboard = ZTrue : _
  705.          ZSuspendAutologoff = ZTrue : _
  706.          GOSUB 21660 : _
  707.          ZSuspendAutologoff = ZFalse : _
  708.          GOSUB 20335 : _
  709.          IF ZFileSysParm > 1 THEN _
  710.             RETURN
  711. 20380 ZStopInterrupts = ZFalse
  712.       WasTU = 0
  713.       SWAP WasTU,ZPageLength
  714.       CALL BufFile (ZFileName$,WasX)
  715.       SWAP WasTU,ZPageLength
  716.       ZNonStop = (ZPageLength < 1)
  717.       IF StopFile THEN _
  718.          DnldCompleted = ZFalse : _
  719.          GOTO 20390
  720. 20381 IF (ZAnsIndex = LastDnld OR NOT ZConcatFIles) THEN _
  721.          CALL QuickTPut (CHR$(26),0) : _
  722.          IF NOT ZLocalUser AND ZSubParm = 0 THEN _
  723.             FOR WasX = 1 TO 5 : _
  724.                CALL PutCom (CHR$(7)) : _
  725.                CALL DelayTime (3) : _
  726.             NEXT
  727. 20385 DnldCompleted = ZTrue
  728. 20390 GOTO 21760
  729. '
  730. ' *  U - COMMAND FROM FILES MENU (UPLOAD)
  731. '
  732. 20395 GOSUB 21640
  733.       IF ZFileSysParm > 1 THEN _
  734.          RETURN
  735.       ZOutTxt$ = "Correct name of file to upload" + _
  736.            ZPressEnterExpert$
  737.       GOSUB 21660
  738.       IF ZFileSysParm > 1 THEN _
  739.          RETURN
  740.       IF ZWasQ = 0 THEN _
  741.          RETURN
  742.       ZUserIn$(ZAnsIndex) = ZUserIn$(1)
  743.       GOTO 20435
  744. 20400 CALL TimeBack (1)
  745.       GOSUB 20420
  746.       ZAutoLogOffReq = 0
  747.       FirstUpld = ZAnsIndex
  748.       GOTO 20430
  749. 20420 ZOutTxt$ = "Upload what file(s)"
  750.       ZStackC = ZTrue
  751.       GOSUB 21668
  752.       RETURN
  753. '
  754. ' *  SEARCH FOR DUPLICATE FILENAME
  755. '
  756. 20430 ZAnsIndex = ZLastIndex
  757.       GOSUB 20470
  758.       ZLastIndex = ZLastIndex + (WasX > 0)
  759.       LastUpld = ZLastIndex
  760. 20432 FOR ZAnsIndex = FirstUpld TO LastUpld
  761.          GOSUB 20470
  762.          GOSUB 20435
  763.          FirstUpld = FirstUpld + 1
  764.          IF ZFileSysParm > 1 THEN _
  765.             ZAnsIndex = LastUpld + 1
  766.       NEXT
  767.       ZCmdTransfer$ = ""
  768.       RETURN
  769. 20435 ZFileNameHold$ = ZUserIn$(ZAnsIndex)
  770.       ExtSrch = ZFalse
  771.       IF INSTR(ZFileNameHold$,".") = 0 THEN _
  772.          ZFileNameHold$ = ZFileNameHold$ + "." + ZDefaultExtension$
  773.       CALL AllCaps(ZFileNameHold$)
  774.       ZFileName$ = ZFileNameHold$
  775.       ZViolation$ = "Upload "
  776.       CALL NoPath (ZFileName$,BadFileNameIndex)
  777.       IF BadFileNameIndex THEN _
  778.          GOTO 20451
  779.       CALL BadFile (ZFileName$,BadFileNameIndex)
  780.       ON BadFileNameIndex GOTO 20440,20451,20515
  781. 20440 CALL RotorsDir (ZFileName$,ZSubDir$(),ZSubDirCount,ZTrue,"U")
  782. 20445 IF ZOK THEN _
  783.          GOTO 20452
  784.       IF INSTR(ZFileName$,".") = 0 THEN _
  785.          GOTO 20475
  786.       CALL BreakFileName (ZFileName$,DR$,WasX$,Extension$,ZFalse)
  787.       WasI = 1
  788. 20447 WasJ = INSTR(MID$(ZCompressedExt$+". ",WasI),".")
  789.       IF WasJ = 0 THEN _
  790.          GOTO 20475
  791.       Check$ = MID$(ZCompressedExt$,WasI,WasJ-1)
  792.       WasI = WasI + WasJ
  793. 20450 IF Extension$ <> Check$ THEN _
  794.          CALL RotorsDir (WasX$ + "." + Check$,ZSubDir$(),ZSubDirCount,ZTrue,"U") : _
  795.          IF ZOK THEN _
  796.             ExtSrch = ZTrue : _
  797.             GOTO 20452
  798.       GOTO 20447
  799. 20451 ZOutTxt$ = "Invalid file name <" + ZFileName$ + ">"
  800.       GOTO 20395
  801. 20452 IF ZUserSecLevel < ZOverWriteSecLevel THEN _
  802.          GOTO 20453
  803.       IF ExtSrch AND (WasX$ + "." + Check$) <> ZFileName$ THEN _
  804.          ZOutTxt$ = WasX$ + "." + Check$ + " already here, " + _
  805.                     "upload anyway (Y,[N])" _
  806.       ELSE ZOutTxt$ = "Overwrite file (Y,[N])"
  807.       GOSUB 21660
  808.       IF ZFileSysParm > 1 THEN _
  809.          RETURN
  810.       IF NOT ZYes THEN _
  811.          GOTO 20453
  812.       ZWasZ$ = ZFileName$
  813.       CALL KillWork (ZFileName$)
  814.       IF ZErrCode <> 0 AND ZErrCode <> 53 THEN _
  815.          ZOutTxt$ = "Unable to overwrite" : _
  816.          GOSUB 21660 : _
  817.          RETURN
  818.       GOTO 20475
  819. 20453 CLOSE 2
  820.       IF ZUserSecLevel >= ZAddDirSecurity THEN _
  821.          GOTO 20455
  822. 20454 CALL QuickTPut1 ("Thanks, but we already have " + ZFileNameHold$)
  823.       CALL UpdtCalr ("Upload duplicate " + ZFileNameHold$,1)
  824.       RETURN
  825. 20455 ZOutTxt$ = "Add new directory entry (Y,[N])"
  826.       ZTurboKey = - ZTurboKeyUser
  827.       GOSUB 21660
  828.       IF ZFileSysParm > 1 THEN _
  829.          RETURN
  830.       IF NOT ZYes THEN _
  831.          RETURN
  832.       AddingDescOnly = ZTrue
  833.       ZWasFT$ = "l"
  834.       GOSUB 20702
  835.       RETURN
  836. 20470 ' *** CHECK FOR Protocol IN FILE LIST ***
  837.       ZWasZ$ = ZUserIn$(ZAnsIndex)
  838.       CALL AllCaps(ZWasZ$)
  839.       WasX = 0
  840.       IF LEN (ZWasZ$) = 1 THEN _
  841.          WasX = INSTR(ZDefaultXfer$,ZWasZ$) : _
  842.          IF WasX > 0 THEN _
  843.             ZAnsIndex = ZAnsIndex + 1 : _
  844.             ZCmdTransfer$ = ZWasZ$ : _
  845.             ZAutoDownInProgress = ZFalse : _
  846.             IF MID$(ZInternalEquiv$,WasX,1) = "N" THEN _
  847.                ZCmdTransfer$ = ""
  848.       RETURN
  849. 20475 ZWasZ$ = ZUpldDriveFile$
  850.       CALL FindFree
  851.       IF VAL(ZFreeSpace$) < 4096 THEN _
  852.          CALL QuickTPut1 ("No room for uploads.  Try tomorrow.") : _
  853.          ZAnsIndex = ZLastIndex + 1 : _
  854.          RETURN
  855.       ZOutTxt$ = "Upload disk has" + _
  856.            ZFreeSpace$
  857.       GOSUB 21640
  858.       IF ZFileSysParm > 1 THEN _
  859.          RETURN
  860.       ZLine25$ = "(U) " + _
  861.                  ZFileNameHold$
  862.       ZSubParm = 2
  863.       CALL Line25
  864.       ZOutTxt$ = ""
  865.       ZOK = ZTrue
  866. 20477 CALL XferType (2,ZTrue)
  867.       IF ZFF THEN _
  868.          GOTO 20500
  869.       CALL XferType (1,ZTrue)
  870.       IF ZSubParm = -1 THEN _
  871.          ZFileSysParm = 7 : _
  872.          RETURN
  873. 20500 ZTransferFunction = 2
  874.       ZAutoDownInProgress = ZFalse
  875.       GOSUB 21790
  876.       IF ZFileSysParm > 1 THEN _
  877.          RETURN
  878.       ON INSTR("AXCYN",ZInternalProt$) GOTO _
  879.          20560, _         ' ASCII UPLOAD
  880.          20542, _         ' Xmodem
  881.          20542, _         ' Xmodem CRC
  882.          20542, _         ' YMODEM
  883.          20735            ' NONE - CANCEL
  884.       GOTO 20261
  885. 20510 WasD$ = "<Esc> by SysOp aborts"
  886.       GOSUB 21710
  887.       RETURN
  888. 20515 CALL SecViolation
  889.       IF ZDenyAccess THEN _
  890.          ZFileSysParm = 4 : _
  891.          RETURN
  892.       GOTO 20420
  893. '
  894. ' *  Xmodem/YMODEM UPLOAD DRIVER
  895. '
  896. 20542 WasA1$ = "RECEIVE"
  897.       GOSUB 20320
  898.       IF ZFileSysParm > 1 THEN _
  899.          RETURN
  900.       ZOK = ZTrue
  901.       GOSUB 20860
  902.       IF ZFileSysParm > 1 THEN _
  903.          RETURN
  904.       IF ZOK THEN _
  905.          GOTO 20700
  906.       GOTO 20730
  907. '
  908. ' *  ASCII UPLOAD
  909. '
  910. 20560 LineACK = (ZDefaultLineACK$ <> "")
  911.       IF LineACK THEN _
  912.          ZOutTxt$ = "Acknowledge each line ([Y],N)" : _
  913.          ZTurboKey = - ZTurboKeyUser : _
  914.          LineACK = NOT ZNo : _
  915.          GOSUB 21660 : _
  916.          IF ZFileSysParm > 1 THEN _
  917.             RETURN
  918.       GOSUB 20337
  919.       CALL QuickTPut1 ("Transfer MUST end with a <Ctrl-K>")
  920.       CALL QuickTPut1 (ZProtoPrompt$+" RECEIVE of " + ZFileNameHold$ + " ready")
  921.       ZOK = ZFalse
  922.       XOff = ZFalse
  923.       CALL OpenOutW(ZFileName$)
  924.       IF ZErrCode <> 0 AND ZErrCode <> 53 THEN _
  925.          ZWasEL = 20560 : _
  926.          GOTO 21900
  927.       GOSUB 20510
  928.       IF ZFileSysParm > 1 THEN _
  929.          RETURN
  930. 20600 CALL EofComm (Char)
  931.       WHILE Char <> -1
  932.          CALL Carrier
  933.          IF ZSubParm = -1 THEN _
  934.             ZFileSysParm = 7 : _
  935.             RETURN
  936.          IF NOT ZFossil THEN _
  937.             IF LOF(3) < 512 THEN _
  938.                CALL PutCom(ZXOff$) : _
  939.                XOff = ZTrue
  940. 20610    CALL FlushCom (WasX$)
  941.          IF ZSubParm = -1 THEN _
  942.             ZFileSysParm = 7 : _
  943.             RETURN
  944.          IF INSTR(WasX$,CHR$(11)) THEN _
  945.             GOTO 20650
  946.          ZOK = ZTrue
  947. 20620    CALL PrintWork (WasX$)
  948.          IF LineACK THEN _
  949.             IF INSTR(WasX$,CHR$(10)) > 0 THEN _
  950.                CALL PutCom (ZDefaultLineACK$)
  951.          IF ZErrCode <> 0 THEN _
  952.             ZWasEL = 20620 : _
  953.             GOTO 21900
  954.          WasD$ = WasX$
  955.          NumReturns = 0
  956.          GOSUB 21720
  957.          IF ZFileSysParm > 1 THEN _
  958.             RETURN
  959. 20621    CALL FindFKey
  960.          IF ZSubParm < 0 THEN _
  961.             ZFileSysParm = 2 : _
  962.             RETURN
  963.          IF ZKeyPressed$ = ZEscape$ THEN _
  964.             GOTO 20745
  965.          IF NOT ZOK THEN _
  966.             GOTO 20670
  967.       CALL EofComm (Char)
  968. 20630 WEND
  969.       CALL Carrier
  970.       IF ZSubParm = -1 THEN _
  971.          ZFileSysParm = 7 : _
  972.          RETURN
  973.       IF XOff THEN _
  974.          XOff = ZFalse : _
  975.          CALL PutCom (ZXOn$) : _
  976.          IF ZErrCode <> 0 THEN _
  977.             ZWasEL = 20630 : _
  978.             GOTO 21900
  979.       GOTO 20600
  980. 20650 WasX = INSTR(WasX$,CHR$(11))
  981.       IF WasX = 1 THEN _
  982.          IF NOT ZOK THEN _
  983.             GOTO 20730 _
  984.          ELSE GOTO 20700
  985.       CALL PrintWorkA (LEFT$(WasX$,WasX-1))
  986.       IF ZErrCode <> 0 THEN _
  987.          ZWasEL = 20650 : _
  988.          GOTO 21900
  989.       GOTO 20700
  990. 20670 ZOutTxt$ = ZXOff$ + _
  991.            "System error! Upload aborted <Ctrl-K> continues"
  992. 20675 GOSUB 21650
  993.       IF ZFileSysParm > 1 THEN _
  994.          RETURN
  995.       CALL DelayTime (3)
  996.       CALL PutCom(ZXOn$)
  997. 20680 CALL EofComm (Char)
  998.       WHILE Char <> -1
  999.          CALL FlushCom(WasX$)
  1000.          IF INSTR(WasX$,CHR$(11)) THEN _
  1001.             GOTO 20730
  1002. 20685    CALL Carrier
  1003.          IF ZSubParm = -1 THEN _
  1004.             ZFileSysParm = 7 : _
  1005.             RETURN
  1006.       CALL EofComm (Char)
  1007.       WEND
  1008.       GOTO 20680
  1009. '
  1010. ' *  UPDATE UPLOAD DIRECTORY
  1011. '
  1012. 20700 GOSUB 21780
  1013.       IF ZFileSysParm > 1 THEN _
  1014.          RETURN
  1015. 20702 CALL UpdtUpload (ZCategoryName$(),ZCategoryCode$(), ZLinesInMsg)
  1016.       ZPrivateDoor = ZFalse
  1017.       IF NOT ZGetExtDesc THEN _
  1018.          GOTO 20710
  1019.       ZMsgHeader$ = "Extended Description for " + ZFileNameHold$
  1020.       ZSysopComment = ZTrue
  1021.       ZMaxMsgLines = ZMaxExtendedLines
  1022.       WasLL = ZRightMargin
  1023.       ZRightMargin = 30 + ZMaxDescLen
  1024.       IF ZRightMargin > 74 THEN _
  1025.          ZRightMargin = 74
  1026.       ZFileSysParm = 5
  1027.       RETURN
  1028. 20705 ZMaxMsgLines = ZMaxMsgLinesDef
  1029.       ZRightMargin = WasLL
  1030.       GOSUB 20702
  1031.       GOTO 20432
  1032. 20710 AddingDescOnly = ZFalse
  1033.       IF ZBytesInFile# > 0.0 THEN _
  1034.          GOTO 21770
  1035. 20730 GOSUB 21780
  1036.       CALL QuickTPut1 ("Upload aborted")
  1037.       LastUpld = 0
  1038.       ZPrivateDoor = ZFalse
  1039. 20735 CALL KillWork (ZFileName$)
  1040.       IF ZErrCode <>0 THEN _
  1041.          ZWasEL = 20736 : _
  1042.          GOTO 21900
  1043.       ZAnsIndex = ZLastIndex + 1
  1044.       ZLastIndex = 0
  1045.       RETURN
  1046. '
  1047. ' *  Sysop ABORTED UPLOAD
  1048. '
  1049. 20745 ZOutTxt$ = ZXOff$ + _
  1050.            "SysOp aborted upload. Stop transfer. <Ctrl-K> continues"
  1051.       GOTO 20675
  1052. '
  1053. ' *  CALCULATE DOWNLOAD TIME ESTIMATE
  1054. '
  1055. 20750 ZStartOfHeader$ = CHR$(1 - (ZInternalProt$ = "Y"))
  1056.       CALL OpenRSeq (ZFileName$,MaxBlock,ZWasDF,ZFLen)
  1057. 20760 IF ZErrCode <> 0 THEN _
  1058.          CALL QuickTPut1 ("Unable to access "+ZFileNameHold$) : _
  1059.          CALL UpdtCalr ("Unable to access "+ZFileName$,2) : _
  1060.          ZOK = ZFalse : _
  1061.          ZErrCode = 0 : _
  1062.          ZBytesInFile# = 0 : _
  1063.          RETURN
  1064.       ZBytesInFile# = LOF(2)
  1065.       ZNumDnldBytes! = LOF(2)
  1066.       ZOK = ZTrue
  1067.       IF SizeOnly THEN _
  1068.          SizeOnly = ZFalse : _
  1069.          RETURN
  1070.       ZBlocksInFile# = MaxBlock
  1071.       IF ZBatchTransfer THEN _
  1072.          Temp# = BatchBlocks# + ZBlocksInFile# : _
  1073.          CALL CheckTimeRemain (MinsRemaining) : _
  1074.          IF (NOT PersonalDnld) AND _
  1075.             (INT(Temp# / 60) + 1 > MinsRemaining) THEN _
  1076.             CALL QuickTPut1 ("Omitting " + ZFileNameHold$ + ".  Insufficient time") : _
  1077.             ZAutoLogoffReq = ZFalse : _
  1078.             RETURN _
  1079.          ELSE BatchBlocks# = Temp# : _
  1080.               BatchBytes# = BatchBytes# + ZBytesInFile# : _
  1081.               CALL OpenWorkA (ZNodeWorkFile$) : _
  1082.               CALL PrintWorkA (ZFileName$) : _
  1083.               ZDownFiles = ZDownFiles + 1 : _
  1084.               RETURN
  1085.       ZDownFiles = 1
  1086. 20780 ZOutTxt$ = "File Size    :"
  1087.       ZOK = ZTrue
  1088.       IF ZBlockSize > 0 THEN _
  1089.          ZOutTxt$ = ZOutTxt$ + _
  1090.               STR$(FIX(ZBlocksInFile#)) + _
  1091.               " blocks "
  1092. 20785 ZBlocksInFile# = ZBlocksInFile# / _
  1093.                         VAL(MID$("00000300045012002400480096019203840", -4 * ZBPS, 4))
  1094.       ZBlocksInFile# = ZBlocksInFile# * ZFLen / ZSpeedFactor!
  1095.       IF (ZAnsIndex > 1 AND ZConcatFIles) THEN _
  1096.          RETURN
  1097.       ZOutTxt$ = ZOutTxt$ + _
  1098.            STR$(ZBytesInFile#) + _
  1099.            " bytes"
  1100.       GOSUB 21650
  1101.       IF ZFileSysParm > 1 THEN _
  1102.          RETURN
  1103.       IF ZBytesInFile# < 1 THEN _
  1104.          RETURN
  1105. 20790 ZSubParm = 2
  1106.       CALL Line25
  1107.       ZOutTxt$ = "Transfer Time:" + _
  1108.          STR$(INT(ZBlocksInFile# / 60)) + _
  1109.          " min," + _
  1110.          STR$(INT(ZBlocksInFile# - (INT(ZBlocksInFile# / 60) * 60))) + _
  1111.          " sec (approx)"
  1112.       GOSUB 21650
  1113.       IF ZFileSysParm > 1 THEN _
  1114.          RETURN
  1115. 20791 IF PersonalDnld THEN _
  1116.          RETURN
  1117.       CALL CheckTimeRemain (MinsRemaining)
  1118.       IF ZSubParm = -1 THEN _
  1119.          ZFileSysParm = 6 : _
  1120.          RETURN
  1121.       ZOK = ZTrue
  1122.       IF (INT(ZBlocksInFile# / 60) + 1) > MinsRemaining THEN _
  1123.          ZOutTxt$ = "Not enough time left!" : _
  1124.          CALL UpdtCalr (ZFileName$ + " " + ZOutTxt$,2) : _
  1125.          CALL QuickTPut1 (ZOutTxt$): _
  1126.          ZOutTxt$ = "" : _
  1127.          ZOK = ZFalse : _
  1128.          ZAutoLogoffReq = ZFalse : _
  1129.          RETURN
  1130.       IF ZRatioRestrict# > 0 THEN _
  1131.          CALL QuickTPut1 ("New statistics will be") : _
  1132.          CALL CheckRatio (ZTrue)
  1133.       RETURN
  1134. 20810 ZDelay! = TIMER + 6
  1135. 20840 CALL EofComm (Char)
  1136.       IF Char = -1 THEN _
  1137.          GOTO 20850
  1138.       CALL FlushCom(ZWasY$)
  1139.       RETURN
  1140. 20850 CALL CheckTime (ZDelay!, TempElapsed!, 1)
  1141.       IF TempElapsed! > 0 THEN GOTO 20840
  1142. 20851 ZWasY$ = ""
  1143.       CALL CheckCarrier
  1144.       IF ZSubParm = -1 THEN _
  1145.          ZFileSysParm = 7 : _
  1146.          RETURN
  1147.       RETURN
  1148. '
  1149. ' *  Xmodem/YMODEM UPLOAD
  1150. '
  1151. 20860 GOSUB 20992
  1152.       IF ZFileSysParm > 1 THEN _
  1153.          RETURN
  1154.       IF NOT ZEightBit THEN _
  1155.          GOSUB 21280 : _
  1156.          IF ZFileSysParm > 1 THEN _
  1157.             RETURN
  1158. 20900 WasX$ = ""
  1159.       Sec = 1
  1160.       'CALL OpenOutW (ZFileName$)
  1161.       IF ZFLen > ZWriteBufDef THEN _
  1162.          WriteBuf = ZFLen _
  1163.       ELSE WriteBuf = ZWriteBufDef
  1164.       CALL OpenRSeq (ZFileName$,WasY,ZWasDF,WriteBuf)
  1165.       IF ZErrCode <> 0 AND ZErrCode <> 53 THEN _
  1166.          ZWasEL = 20900 : _
  1167.          GOTO 21900
  1168.       FIELD #2, WriteBuf AS ZUpldRec$
  1169.       RecsWrit = 0
  1170.       NumInBuff = 0
  1171.       TransferAbort! = TIMER + ZWaitBeforeDisconnect
  1172.       Year$ = " " + _
  1173.             CHR$(1) + _
  1174.             CHR$(2) + _
  1175.             ZEndTransmission$ + _
  1176.             ZCancel$
  1177. 20903 CALL PutCom (ZNAK$)
  1178. 20920 WasX = 1
  1179. 20922 CALL CheckCarrier
  1180.       IF ZSubParm = -1 THEN _
  1181.          ZFileSysParm = 7 : _
  1182.          RETURN
  1183.       CALL FindFKey
  1184.       IF ZKeyPressed$ = ZEscape$ THEN _
  1185.          GOSUB 20510 :_
  1186.          IF ZFileSysParm > 1 THEN _
  1187.             RETURN _
  1188.          ELSE GOTO 21240
  1189.       GOSUB 20810
  1190.       IF ZFileSysParm > 1 THEN _
  1191.          RETURN
  1192. 20930 WasJ = INSTR(Year$,LEFT$(ZWasY$,1))
  1193.       ON WasJ GOTO 20960,20999,20999,21220,21230
  1194. 20960 IF ZWasY$ <> "" THEN _
  1195.          GOSUB 21280 : _
  1196.          IF ZFileSysParm > 1 THEN _
  1197.             RETURN _
  1198.          ELSE CALL CheckTime (TransferAbort!,TempElapsed!,1) : _
  1199.               ON ZSubParm GOTO 20920,21230
  1200. 20970 WasX = WasX + 1
  1201.       CALL DelayTime (1)
  1202.       CALL PutCom (ZNAK$)
  1203.       IF WasX < 6 THEN _
  1204.          GOTO 20922
  1205.       WasD$ = "Upload Timeout"
  1206.       GOSUB 21710
  1207.       IF ZFileSysParm > 1 THEN _
  1208.          RETURN
  1209.       CALL CheckTime (TransferAbort!,TempElapsed!,1)
  1210.       ON ZSubParm GOTO 20990,21230
  1211. 20990 GOTO 20920
  1212. '
  1213. ' *  CHANGE TO 8 BIT FOR Xmodem
  1214. '
  1215. 20992 GOSUB 20510
  1216.       IF ZFileSysParm > 1 THEN _
  1217.          ZFileSysParm = 2 : _
  1218.          RETURN
  1219.       IF NOT ZEightBit THEN _
  1220.          PrevLineCntl = INP (ZLineCntlReg) : _
  1221.          CALL DelayTime (3) : _
  1222.          SwitchToEight = ZTrue : _
  1223.          OUT ZLineCntlReg,3
  1224. 20996 WasSO = 0
  1225.       RETURN
  1226. '
  1227. ' *  EXPECTED BLOCK LENGTH. 132 FOR CheckSum, 133 FOR CRC, 1029 FOR YMODEM
  1228. '
  1229. 20999 SOL = 896 * WasJ - 1659 + ZCheckSum
  1230.       DataSol = 128 - (SOL > 1024)*896
  1231.       GOTO 21020
  1232. '
  1233. ' *  Xmodem/YMODEM UPLOAD
  1234. '
  1235. 21000 GOSUB 20810
  1236.       IF ZFileSysParm > 1 THEN _
  1237.          RETURN
  1238.       IF ZWasY$ = "" THEN _
  1239.          WasD$ = "Upload Timeout" : _
  1240.          GOSUB 21710 : _
  1241.          IF ZFileSysParm > 1 THEN _
  1242.             RETURN _
  1243.          ELSE GOTO 21040
  1244. 21020 WasX$ = WasX$ + _
  1245.            ZWasY$
  1246.       IF LEN(WasX$) < SOL THEN _
  1247.          GOTO 21000
  1248. 21040 IF LEN(WasX$) = SOL THEN _
  1249.          GOTO 21090
  1250. 21050 IF LEN(WasX$) > SOL THEN _
  1251.          GOTO 21180
  1252. 21060 IF WasX$ = ZEndTransmission$ THEN _
  1253.          GOTO 21220
  1254. 21070 IF WasX$ = ZCancel$ THEN _
  1255.          GOTO 21230
  1256. 21080 GOTO 21170
  1257. 21090 WasJX = ASC(MID$(WasX$,2,1))
  1258.       IF Sec = WasJX THEN _
  1259.          GOTO 21100
  1260.       GOTO 21200
  1261. 21100 IF (Sec XOR 255) <> ASC(MID$(WasX$,3,1)) THEN _
  1262.          GOTO 21210
  1263. 21110 IF ZCheckSum THEN _
  1264.          WasWK$ = MID$(WasX$,4,128) : _
  1265.          GOSUB 21750 : _
  1266.          IF ZFileSysParm > 1 THEN _
  1267.             RETURN _
  1268.          ELSE IF XmodemChecksum <> ASC(MID$(WasX$,132,1)) THEN _
  1269.             GOTO 21190 _
  1270.          ELSE GOTO 21120
  1271.       WasWK$ = MID$(WasX$,4)
  1272.       GOSUB 21750
  1273.       IF ZFileSysParm > 1 THEN _
  1274.          RETURN
  1275. 21113 IF CRCValue <> 0 THEN _
  1276.          GOTO 21191
  1277. 21120 WasSO = WasSO + 1
  1278.       CALL PutCom (ZAcknowledge$)
  1279. 21131 IF NumInBuff >= WriteBuf THEN _
  1280.          NumInBuff = 0 : _
  1281.          CALL PutWork (ZUpldRec$,RecsWrit,WriteBuf) : _
  1282.          IF ZErrCode <> 0 THEN _
  1283.             ZWasEL = 21131 : _
  1284.             GOTO 21900
  1285.       MID$(ZUpldRec$,NumInBuff+1,DataSol) = WasWK$
  1286.       NumInBuff = NumInBuff + DataSol
  1287. 21145 Sec = 255 AND (Sec + 1)
  1288.       CALL QuickLPrnt ("OK Rec Blk #",WasSO)
  1289. 21150 WasX$ = ""
  1290.       XmodemChecksum = 0
  1291.       TransferAbort! = TIMER + 45
  1292.       GOTO 20920
  1293. 21170 ZOutTxt$ = "Short Blk #"
  1294.       GOTO 21212
  1295. 21180 ZOutTxt$ = "Long Blk #"
  1296.       GOTO 21212
  1297. 21190 ZOutTxt$ = "Chksum Error #"
  1298.       GOTO 21212
  1299. 21191 ZOutTxt$ = "CRC Error"
  1300.       GOTO 21212
  1301. 21200 IF Sec < WasJX THEN _
  1302.          ZOutTxt$ = "Blk # Error in #" : _
  1303.          GOTO 21212
  1304.       CALL PutCom (RIGHT$(ZAckChar$,1 - (WasJX = 0)))
  1305.       GOTO 21150
  1306. 21210 ZOutTxt$ = "Complement Error in #"
  1307. 21212 CALL PutCom (ZNAK$)
  1308.       CALL LPrnt(ZLineFeed$ + ZOutTxt$ + STR$(WasSO + 1),0)
  1309.       GOTO 21150
  1310. 21220 IF NumInBuff < 1 THEN _
  1311.          GOTO 21225
  1312.       WasWK$ = LEFT$(ZUpldRec$,NumInBuff)
  1313.       CALL OpenRSeq (ZFileName$,MaxBlock,ZWasDF,128)
  1314.       IF ZErrCode > 0 THEN _
  1315.          ZWasEL = 21220 : _
  1316.          GOTO 21900
  1317.       LastBlock = MaxBlock
  1318.       FIELD #2, 128 AS ZUpldRec$
  1319.       MaxBlock = CDBL(RecsWrit) * WriteBuf / 128
  1320.       FOR WasI = 1 TO NumInBuff/128
  1321.          CALL PutWork (MID$(WasWK$,128*WasI-127,128),MaxBlock,128)
  1322.          IF ZErrCode > 0 THEN _
  1323.             ZWasEL = 21220 : _
  1324.             GOTO 21900
  1325.       NEXT
  1326.       CLOSE 2
  1327. 21225 CALL PutCom (ZAcknowledge$)
  1328.       GOTO 21250
  1329. 21230 WasD$ = ZLineFeed$ + _
  1330.            "Transfer Aborted"
  1331.       GOSUB 21710
  1332.       IF ZFileSysParm > 1 THEN _
  1333.          RETURN
  1334. 21240 CALL EofComm (Char)
  1335.       IF Char <> -1 THEN _
  1336.          GOSUB 21280 : _
  1337.          IF ZFileSysParm > 1 THEN _
  1338.             RETURN _
  1339.          ELSE CALL DelayTime (1) : _
  1340.          GOTO 21240
  1341.       CALL PutCom (ZCancel$ + ZCancel$)
  1342.       CALL DelayTime (1)
  1343.       CALL EofComm (Char)
  1344.       IF Char <> -1 THEN _
  1345.          GOTO 21240
  1346.       ZOK = ZFalse
  1347. 21250 ZEightBit = ZTrue
  1348.       RETURN
  1349. '
  1350. ' *  CLEAR GARBAGE OUT OF COMMUNICATIONS BUFFER
  1351. '
  1352. 21280 CALL CheckCarrier
  1353.       IF ZSubParm = -1 THEN _
  1354.          ZFileSysParm = 7 : _
  1355.          RETURN
  1356.       CALL EofComm (Char)
  1357.       IF Char = -1 THEN _
  1358.          RETURN
  1359. 21281 CALL FlushCom(ZWasDF$)
  1360.       'IF ZSubParm = -1 THEN _
  1361.       '   ZFileSysParm = 7 : _
  1362.       '   RETURN
  1363.       GOTO 21280
  1364. '
  1365. ' *  Xmodem/YMODEM DOWNLOAD
  1366. '
  1367. 21300 GOSUB 20992
  1368.       IF ZFileSysParm > 1 THEN _
  1369.          RETURN
  1370.       Sec = 0
  1371.       GOSUB 21280
  1372.       IF ZFileSysParm > 1 THEN _
  1373.          RETURN
  1374.       ZNAK$ = CHR$(21)
  1375.       TransferAbort! = TIMER + ZWaitBeforeDisconnect
  1376. 21303 FIELD 2,ZFLen AS ZDnldRecord$
  1377. '
  1378. ' *  ROUTINE TO START AN "Xmodem" OR "YMODEM" DOWNLOAD.  CHECK'S INITIAL
  1379. ' *  "HANDSHAKE" TO SEE IF CHARACTER IS SENT IS A:
  1380. ' *           "X" = Xmodem WITH CheckSum AND 128 CHARACTER RECORDS
  1381. ' *           "C" = Xmodem WITH CRC CHECK AND 128 CHARACTER RECORDS
  1382. ' *           "Y" = YMODEM WITH CRC CHECK AND 1024 CHARACTER RECORDS
  1383. '
  1384. 21350 CALL EofComm (Char)
  1385.       WHILE Char <> -1
  1386. 21360    CALL GetCom(ZWasY$)
  1387.          IF ZWasY$ = ZCancel$ THEN _
  1388.             GOTO 21560
  1389. 21380    ZCheckSum = (ZWasY$ = ZNAK$)
  1390.          IF ZCheckSum THEN _
  1391.             ZFF = INSTR(ZInternalEquiv$,"X") : _
  1392.             IF ZFF > 0 THEN _
  1393.                ZWasFT$ = MID$(ZDefaultXfer$,ZFF,1) : _
  1394.                GOTO 21480 _
  1395.             ELSE ZWasFT$ = "X" : _
  1396.                  GOTO 21480 _
  1397.          ELSE IF ZWasY$ = "C" THEN _
  1398.                  GOTO 21480
  1399.          CALL EofComm (Char)
  1400. 21390 WEND
  1401.       GOSUB 21460
  1402.       IF ZFileSysParm > 1 THEN _
  1403.          RETURN
  1404.       IF ZKeyPressed$ = ZEscape$ THEN _
  1405.          RETURN
  1406.       CALL CheckTime (TransferAbort!, TempElapsed!, 1)
  1407.       ON ZSubParm GOTO 21350,21455
  1408. 21410 TransferAbort! = TIMER + ZWaitBeforeDisconnect
  1409. '
  1410. ' *  ROUTINE TO WAIT FOR AN ACKNOWLEDGEMENT ON AN "Xmodem" OR "YMODEM"
  1411. ' *  DOWNLOAD
  1412. '
  1413. 21415 CALL EofComm (Char)
  1414.       IF Char <> -1 THEN _
  1415.          GOTO 21420
  1416.       GOSUB 21460
  1417.       IF ZFileSysParm > 1 THEN _
  1418.          RETURN
  1419.       IF ZKeyPressed$ = ZEscape$ THEN _
  1420.          RETURN
  1421.       CALL CheckTime (TransferAbort!, TempElapsed!, 1)
  1422.       ON ZSubParm GOTO 21415,21455
  1423. 21420 CALL GetCom(ZWasY$)
  1424.       IF ZWasY$ = ZAcknowledge$ THEN _
  1425.          GOTO 21470
  1426. 21440 IF ZWasY$ <> ZNAK$ THEN _
  1427.          GOTO 21450
  1428. 21443 WasD$ = ZLineFeed$ + _
  1429.          "Error -> retrans #" + _
  1430.          STR$(WasSO)
  1431.       GOSUB 21710
  1432.       IF ZFileSysParm > 1 THEN _
  1433.          RETURN
  1434. 21445 WasSO = WasSO - 1
  1435.       GOTO 21490
  1436. 21450 IF ZWasY$ = ZCancel$ THEN _
  1437.          IF HaveACancel THEN _
  1438.             GOTO 21560 _
  1439.          ELSE HaveACancel = ZTrue
  1440.       CALL CheckTime (TransferAbort!, TempElapsed!, 1)
  1441.       ON ZSubParm GOTO 21415,21455
  1442. 21455 WasD$ = "Download timeout"
  1443.       GOSUB 21710
  1444.       IF ZFileSysParm > 1 THEN _
  1445.          RETURN
  1446.       GOTO 21560
  1447. 21460 CALL CheckCarrier
  1448.       CALL FindFKey
  1449.       IF ZSubParm < 0 THEN _
  1450.          ZFileSysParm = 7 : _
  1451.          RETURN
  1452.       IF ZKeyPressed$ = ZEscape$ THEN _
  1453.          GOTO 21540
  1454.       RETURN
  1455. '
  1456. ' *  DISPLAY BLOCK SENT OK AND THEN READ IN NEXT RECORD FROM DISK TO DOWNLOAD
  1457. '
  1458. 21470 CALL QuickLPrnt ("OK Sent Blk #",WasSO)
  1459. 21480 IF LOC(2) => MaxBlock THEN _
  1460.          GOTO 21530
  1461.       CALL GetWork (ZFLen)
  1462.       IF ZErrCode <> 0 THEN _
  1463.          ZWasEL = 21480 : _
  1464.          GOTO 21900
  1465.       Sec = 255 AND (Sec + 1)
  1466.       GOTO 21490
  1467. '
  1468. ' *  ROUTINE TO WRITE OUT AN "Xmodem" OR "YMODEM" RECORD TO THE COMM. PORT
  1469. '
  1470. 21490 WasSO = WasSO + 1
  1471.       CALL PutCom (ZStartOfHeader$ + CHR$(Sec) + CHR$(Sec XOR 255))
  1472.       CALL PutCom (ZDnldRecord$)
  1473.       HaveACancel = ZFalse
  1474. 21503 WasWK$ = ZDnldRecord$
  1475. 21504 GOSUB 21750
  1476.       IF ZFileSysParm > 1 THEN _
  1477.          RETURN
  1478. 21510 IF ZCheckSum THEN _
  1479.          CALL PutCom(CHR$(XmodemChecksum)) _
  1480.       ELSE CALL PutCom(CHR$(CRCHigh) + CHR$(CRCLow))
  1481.       GOSUB 21280
  1482.       IF ZFileSysParm > 1 THEN _
  1483.          RETURN
  1484.       GOTO 21410
  1485. '
  1486. ' *  END-OF-FILE FOR Xmodem Dnlds -- SEND THE "EOT" CHARACTER AND WAIT UP
  1487. ' *  TO 2 SECONDS FOR A POSITIVE RESPONSE (I.E. AN "ACK").  IF NONE IS
  1488. ' *  RE-TRY UP TO 10 TIMES.  IF No POSITIVE RESPONSE IS RECEIVED AFTER TEN
  1489. ' *  Attempts, ASSUME THE DOWNLOAD WAS UNSUCCESSFULL.
  1490. '
  1491. 21530 CALL PutCom (ZEndTransmission$)
  1492.       WasX = 1
  1493. 21531 GOSUB 20810
  1494.       IF ZFileSysParm > 1 THEN _
  1495.          RETURN
  1496.       IF INSTR(ZWasY$,ZAcknowledge$) THEN _
  1497.          GOTO 21550
  1498.       CALL FindFKey
  1499.       IF ZSubParm < 0 THEN _
  1500.          ZFileSysParm = 2 : _
  1501.          RETURN
  1502.       IF ZKeyPressed$ = ZEscape$ THEN _
  1503.          GOSUB 21540 : _
  1504.          GOTO 21545
  1505.       IF WasX < 10 THEN _
  1506.          WasX = WasX + 1 : _
  1507.          GOTO 21531
  1508.       DnldCompleted = ZFalse
  1509.       GOTO 21230
  1510. 21540 GOSUB 20510
  1511.       IF ZFileSysParm > 1 THEN _
  1512.          RETURN
  1513.       RETURN
  1514. 21545 ZWasY$ = ZCancel$
  1515.       CALL PutCom (ZCancel$ + ZCancel$ + ZCancel$)
  1516.       DnldCompleted = ZFalse
  1517.       GOTO 21250
  1518. 21550 DnldCompleted = ZTrue
  1519.       GOTO 21250
  1520. 21560 IF WasSO >= LastBlock THEN _
  1521.          GOTO 21550
  1522.       DnldCompleted = ZFalse
  1523.       WasD$ = ZLineFeed$ + _
  1524.            "Caller aborted trans"
  1525.       GOSUB 21710
  1526.       IF ZFileSysParm > 1 THEN _
  1527.          RETURN
  1528.       GOTO 21545
  1529. '
  1530. ' STANDARD ENTRY FOR RBBS-PC'S COMMON TERMINAL OUTPUT ROUTINE
  1531. '
  1532. ' Modeled on lines 12975 to 12983 in RBBS-PC.BAS
  1533. 21630 ZSubParm = 1
  1534.       GOTO 21655
  1535. 21640 ZSubParm = 3
  1536.       GOTO 21655
  1537. 21650 ZSubParm = 5
  1538. 21655 CALL TPut
  1539.       IF ZSubParm < 0 THEN _
  1540.          ZFileSysParm = 2 : _
  1541.          RETURN
  1542.       IF ZSubParm = 8 THEN _
  1543.          GOSUB 21660
  1544.       RETURN
  1545. '
  1546. ' STANDARD ENTRY FOR RBBS-PC'S COMMON TERMINAL INPUT ROUTINE
  1547. '
  1548. ' Modeled on lines 12995 to 12997 in RBBS-PC.BAS
  1549. 21660 ZSubParm = 1
  1550.       CALL TGet
  1551. 21665 IF ZSubParm < 0 THEN _
  1552.          ZFileSysParm = 2
  1553.       RETURN
  1554. 21668 CALL PopCmdStack
  1555.       GOTO 21665
  1556. 21700 ZErrCode = 0
  1557.       ZLastIndex = 0
  1558.       RETURN
  1559. '
  1560. ' **** COMMON LOCAL DISPLAY PRINT ***
  1561. '
  1562. '  (formerly lines 1315 to 1320 in RBBS-PC.BAS
  1563. 21710 NumReturns = 1
  1564. 21720 CALL LPrnt (WasD$,NumReturns)
  1565.       RETURN
  1566. '
  1567. ' *  Xmodem / CRC INTERFACE
  1568. '
  1569. '  (formerly line 46000 in RBBS-PC.BAS
  1570. 21750 XmodemChecksum = 0
  1571.       CRCValue = 0
  1572.       CALL Xmodem(WasWK$,XmodemChecksum,CRCValue,CRCHigh,CRCLow)
  1573.       RETURN
  1574. '
  1575. ' * UPDATE DOWNLOAD STATISTICS
  1576. '
  1577. '  (formerly lines 50600 to 50614 in RBBS-PC.BAS
  1578. 21760 GOSUB 21780
  1579.       IF ZFileSysParm > 1 THEN _
  1580.          RETURN
  1581.       IF ZBatchTransfer THEN _
  1582.          CALL LinesInFile (ZNodeWorkFile$,ZDownFiles) _
  1583.       ELSE ZDownFiles = 1
  1584.       IF NOT DnldCompleted THEN _
  1585.          ZAutoLogoffReq = ZFalse : _
  1586.          ZWasDF$ = " Aborted" : _
  1587.          GOTO 21768
  1588.       CALL LogPDown (PersonalDnld,1+ZAnsIndex-FirstDnld)
  1589.       WasX = ((ZRatioRestrict# = 0) AND ZEnforceRatios)
  1590.       IF NOT WasX THEN _
  1591.          ZDnlds = ZDnlds + ZDownFiles : _
  1592.          ZGlobalDLToday! = ZGlobalDLToday! + ZDownFiles : _
  1593.          ZGlobalDnlds = ZGlobalDnlds + ZDownFiles : _
  1594.          ZDLBytes! = ZDLBytes! + ZNumDnldBytes! : _
  1595.          ZGlobalDLBytes! = ZGlobalDLBytes! + ZNumDnldBytes! : _
  1596.          ZDLToday! = ZDLToday! + ZDownFiles : _
  1597.          ZBytesToday! = ZBytesToday! + ZNumDnldBytes! : _
  1598.          ZGlobalBytesToday! = ZGlobalBytesToday! + ZNumDnldBytes!
  1599.       ZNumDnldBytes! = 0
  1600.       CALL Muzak (6)
  1601.       ZWasDF$ = " Downloaded"
  1602.       IF (ZAnsIndex = LastDnld OR NOT ZConcatFIles) THEN _
  1603.          CALL SkipLine (1) : _
  1604.          CALL QuickTPut1 ("Download successful") : _
  1605.          IF WasX THEN _
  1606.             CALL QuickTPut1 ("but not counted against ratios")
  1607. 21768 IF ZAutoDownInProgress THEN _
  1608.          ZWasDF$ = " AUTO" + _
  1609.               MID$(ZWasN$,2)
  1610.       IF INSTR(ZWasN$,"Aborted") THEN _
  1611.          ZAutoDownInProgress = 0
  1612.       ZOutTxt$ = ""
  1613. 21770 CALL AMorPM
  1614.       IF NOT ZBatchTransfer THEN _
  1615.          GOTO 21773
  1616.       CALL OpenWork (2,ZNodeWorkFile$)
  1617.       IF ZErrCode > 0 THEN _
  1618.          RETURN
  1619.       ZWasQ = 0
  1620.       WHILE NOT EOF(2)
  1621.          CALL ReadAny
  1622.          ZWasQ = ZWasQ + 1
  1623.          ZUserIn$(ZWasQ) = ZOutTxt$
  1624.       WEND
  1625. 21772 IF ZWasQ < 1 THEN _
  1626.          ZBatchTransfer = ZFalse : _
  1627.          RETURN
  1628.       CALL OpenWork (2,ZUserIn$(ZWasQ))
  1629.       IF ZErrCode > 0 THEN _
  1630.          ZErrCode = 0 : _
  1631.          ZWasQ = ZWasQ - 1 : _
  1632.          GOTO 21772
  1633.       ZBytesInFile# = LOF(2)
  1634.       ZFileName$ = ZUserIn$(ZWasQ)
  1635. 21773 CALL BreakFileName (ZFileName$,DR$,WasX$,Extension$,ZTrue)
  1636.       ZWasZ$ = WasX$ + _
  1637.            Extension$ + _
  1638.            ZWasDF$ + _
  1639.            " at " + _
  1640.            ZTime$ + _
  1641.            " using " + _
  1642.            ZWasFT$ + _
  1643.            STR$(ZBytesInFile#)
  1644.       CALL UpdtCalr (ZWasZ$,2)
  1645.       IF ZBatchTransfer THEN _
  1646.          ZWasQ = ZWasQ - 1 : _
  1647.          GOTO 21772
  1648.       'CALL CheckRatio (ZFalse)
  1649. 21774 IF ZMenuIndex = 6 THEN _
  1650.          IF DnldCompleted THEN _
  1651.             ZOutTxt$ = WasX$ : _
  1652.             ZSubParm = 5 : _
  1653.             CALL Library
  1654.       RETURN
  1655. '
  1656. ' *****   TURN ON INTERMEDIATE ECHO   ****
  1657. '
  1658. '  (formerly line 50620 in RBBS-PC.BAS
  1659. 21780 IF ZEchoer$ = "I" THEN _
  1660.          CALL SetEcho ("I")
  1661. '
  1662. ' *  RESTORE COMMUNICATIONS AFTER Switch TO 8 BIT
  1663. '
  1664. '  (formerly between lines 50620 and 50630 in RBBS-PC.BAS
  1665.       IF SwitchToEight THEN _
  1666.          IF ZSwitchBack THEN _
  1667.             OUT ZLineCntlReg, PrevLineCntl : _
  1668.             CALL DelayTime (3) : _
  1669.             ZEightBit = ZFalse : _
  1670.             SwitchToEight = ZFalse
  1671.       RETURN
  1672. '
  1673. ' *****  TURN OFF INTERMEDIATE ECHO  ****
  1674. '
  1675. '  (formerly line 50630 in RBBS-PC.BAS
  1676. 21790 IF ZEchoer$ = "I" THEN _
  1677.          CALL SetEcho ("R")
  1678.       RETURN
  1679. '
  1680. ' *****   DIRECTORY SEARCH   ****
  1681. '
  1682. '  (formerly lines 52900 to 52920 in RBBS-PC.BAS
  1683. 21800 WasCK = 2
  1684. 21810 ZOutTxt$ = "Search string or filename (wildcards OK), [ENTER] quits)"
  1685.       ZMacroMin = 99
  1686.       GOSUB 21668
  1687.       IF ZWasQ = 0 THEN _
  1688.          RETURN
  1689. 21820 WasRS$ = ZUserIn$(ZAnsIndex)
  1690.       WildSearch = (INSTR(WasRS$,"*") > 0 OR INSTR(WasRS$,"?") > 0)
  1691.       CALL AllCaps (WasRS$)
  1692.       IF RIGHT$(WasRS$,1) = "*" THEN _
  1693.          IF RIGHT$(WasRS$,2) <> ".*" THEN _
  1694.             WasRS$ = WasRS$ + ".*"
  1695.       SearchString$ = WasRS$
  1696.       SearchDate$ = ""
  1697.       ZJumpSearching = ZFalse
  1698.       WasA1$ = WasRS$
  1699.       ZExtendedOff = ZFalse
  1700.       GOTO 21867
  1701. '
  1702. ' *****  P - personal download  ****
  1703. '
  1704. '  (formerly lines 52950 to 52952 in RBBS-PC.BAS
  1705. 21850 IF ZPersonalBegin < 1 OR ZPersonalLen < 1 THEN _
  1706.          RETURN
  1707.       DnldFlag = 0
  1708.       PersonalDnld = ZTrue
  1709. 21852 CALL PersFile (MID$(ZUserRecord$,ZPersonalBegin,ZPersonalLen),_
  1710.                      DnldFlag)
  1711.       IF ZSubParm = -1 THEN _
  1712.          ZFileSysParm = 7: _
  1713.          RETURN
  1714.       IF ZLastIndex <= 0 THEN _
  1715.          GOTO 21854
  1716.       ZConcatFIles = ZPersonalConcat
  1717.       ZStopInterrupts = ZTrue
  1718.       TimeLockExempt = ZTrue
  1719.       GOSUB 20202
  1720.       IF ZFileSysParm > 1 THEN _
  1721.          GOTO 21854
  1722.       TimeLockExempt = ZFalse
  1723.       ZConcatFIles = ZFalse
  1724.       GOTO 21852
  1725. 21854 PersonalDnld = ZFalse
  1726.       RETURN
  1727. '
  1728. ' *  WasN - COMMAND FROM FILES MENU (DISPLAY NEW FILES SINCE Last DIR DISPLAY)
  1729. '
  1730. '  (formerly lines 53000 to 53070 in RBBS-PC.BAS
  1731. 21860 WasCK = 1
  1732. 21862 WasA1$ = RIGHT$(ZWasLM$,4) +_
  1733.             LEFT$(ZWasLM$,2)
  1734.       ZOutTxt$ = "Files on/after MMDDYY, [S]ince = " + WasA1$
  1735.       GOSUB 21668
  1736.       CALL AraAllCaps (ZUserIn$(),ZAnsIndex)
  1737.       IF ZWasQ = 0 OR ZUserIn$(ZAnsIndex) = "S" THEN _
  1738.          WasRS$ = ZWasLM$ : _
  1739.          GOTO 21866
  1740. 21865 IF LEN(ZUserIn$(ZAnsIndex)) <> 6 THEN _
  1741.          GOTO 21862
  1742.       WasA1$ = ZUserIn$(ZAnsIndex)
  1743.       WasRS$ = RIGHT$(WasA1$,2) + _
  1744.             LEFT$(WasA1$,4)
  1745.       ListNew = ZTrue
  1746. 21866 SearchDate$ = WasRS$
  1747.       SearchString$ = ""
  1748.       ZJumpSearching = ZFalse
  1749.       ZExtendedOff = ZFalse
  1750. 21867 CALL GetDirs (NOT ZExpertUser)
  1751.       IF ZWasQ = 0 THEN _
  1752.          RETURN
  1753. 21871 CALL ConvertDir (ZAnsIndex)
  1754.       ZListDir = ZTrue
  1755.       ListNew = ZTrue
  1756.       ZSearchingAll = ZFalse
  1757. 21875 ZWasZ$ = ZUserIn$(ZAnsIndex)
  1758.       IF NOT ZSearchingAll THEN _
  1759.          IF ZWasZ$ = "ALL" THEN _
  1760.             IF NOT ZLimitSearchToFMS THEN _
  1761.                GOSUB 21890
  1762. 21880 WasQX = ZAnsIndex
  1763.       GOSUB 20157
  1764.       IF ZFileSysParm > 1 THEN _
  1765.          RETURN
  1766.       ZAnsIndex = ZAnsIndex + 1
  1767.       IF ZAnsIndex <= ZLastIndex THEN _
  1768.          GOTO 21875
  1769.       ListNew = ZFalse
  1770.       SearchString$ = ""
  1771.       SearchDate$ = ""
  1772.       RETURN
  1773. 21890 WasG = ZAnsIndex
  1774.       CALL GetAll (ZUserIn$(),WasG)
  1775.       ZSearchingAll = ZTrue
  1776.       ZLastIndex = WasG
  1777.       ZAnsIndex = ZAnsIndex + 1
  1778.       RETURN
  1779. '
  1780. ' *  MAIN FILE SYSTEM ERROR TRAP - ALL ERRORS PASS THROUGH THIS ROUTINE
  1781. '
  1782. '  (formerly lines 13000 to 13500 in RBBS-PC.BAS
  1783. 21900 IF ZDebug THEN _
  1784.          ZOutTxt$ = "RBBSSUB5 DEBUG Error Trap Entry ERL=" + _
  1785.               STR$(ZWasEL) + _
  1786.               " ERR=" + _
  1787.               STR$(ZErrCode) : _
  1788.          IF ZPrinter THEN _
  1789.             CALL Printit(ZOutTxt$) _
  1790.          ELSE CALL LPrnt(ZOutTxt$,1)
  1791.       IF ZWasEL = 20126 AND ZErrCode = 53 THEN _
  1792.          GOTO 20142
  1793.       IF ZWasEL = 20242 AND ZErrCode = 62 THEN _
  1794.          CALL UpdtCalr (ZFileSecFile$ + " bad format!",2) : _
  1795.          GOTO 20247
  1796.       IF ZWasEL = 20263 THEN _
  1797.          ZOutTxt$ = "<Download aborted>" : _
  1798.          DnldCompleted = ZFalse : _
  1799.          GOTO 20390
  1800.       IF ZWasEL = 20560 AND ZErrCode = 67 THEN _
  1801.          GOTO 20451
  1802.       IF ZWasEL = 20560 AND ZErrCode = 70 THEN _
  1803.          IF VAL(ZFreeSpace$) > 1999 THEN _
  1804.             GOTO 20610 _
  1805.          ELSE CALL QuickTPut1 ("No room for uploads. Try tomorrow.") : _
  1806.               GOTO 21700
  1807.       IF ZWasEL = 20620 THEN _
  1808.          GOTO 20670
  1809.       IF ZWasEL = 20650 THEN _
  1810.          GOTO 20670
  1811.       IF ZWasEL = 20736 AND ZErrCode = 53 THEN _
  1812.          GOTO 21700
  1813.       IF ZWasEL = 20900 AND ZErrCode = 75 THEN _
  1814.          GOTO 21230
  1815.       IF ZWasEL = 20900 AND ZErrCode = 70 THEN _
  1816.          CALL QuickTPut1 ("No room for uploads. Try tomorrow.") : _
  1817.          GOTO 21230
  1818.       IF ZWasEL = 21131 OR ZWasEL = 21220 THEN _
  1819.          ZErrCode = 0 : _
  1820.          GOTO 21230
  1821.       IF ZWasEL = 21480 THEN _
  1822.          CALL LogError : _
  1823.          IF ZErrCode = 57 THEN _
  1824.             CALL QuickTPut1 ("Error reading file.  Aborting download") : _
  1825.             DnldCompleted = ZFalse : _
  1826.             GOTO 21230
  1827. 21910 CALL LogError
  1828.       CALL QuickTPut1 (ZCallersRecord$)
  1829.       ZFileSysParm = 3
  1830.       RETURN
  1831. 21920 ' EXIT RBBS-PC FILE SUBSYSTEM
  1832.       END SUB
  1833. 63100 ' $SUBTITLE: 'DoorReturn - Subroutine to process requests from a door'
  1834. ' $PAGE
  1835. '
  1836. '  NAME    -- DoorReturn
  1837. '
  1838. '  INPUTS  -- PARAMETER                      MEANING
  1839. '             DOUTx.DEF               File of requests
  1840. '
  1841. '  OUTPUTS -- ZUserSecLevel     Revised Security Level
  1842. '
  1843. '  PURPOSE -- To give Doors a stable way to make requests
  1844. '             to the host.
  1845. '
  1846.       SUB DoorReturn STATIC
  1847.       IF NOT ZExitToDoors THEN _
  1848.          EXIT SUB
  1849.       CALL OpenUser (ZHighestUserRecord)
  1850.       FIELD 5, 128 AS ZUserRecord$
  1851.       FIELD 5,31 AS ZUserName$, _
  1852.               15 AS ZPswd$, _
  1853.                2 AS ZSecLevel$, _
  1854.               14 AS ZUserOption$,  _
  1855.               24 AS ZCityState$, _
  1856.                2 AS MachineType$, _
  1857.                1 AS ZBankTime$,_
  1858.                4 AS ZTodayDl$, _
  1859.                4 AS ZTodayBytes$, _
  1860.                4 AS ZDlBytes$, _
  1861.                4 AS ZULBytes$, _
  1862.               14 AS ZLastDateTimeOn$, _
  1863.                3 AS ZListNewDate$, _
  1864.                2 AS ZUserDnlds$, _
  1865.                2 AS ZUserUplds$, _
  1866.                2 AS ZElapsedTime$
  1867.       ZSubParm = 6
  1868.       CALL FileLock
  1869.       GET 5,ZUserFileIndex
  1870.       CALL SetSysOp
  1871.       CALL SetUserPref
  1872.       CALL SetUserUpDn
  1873.       ZGlobalsSet = ZFalse
  1874.       CALL SetGlobalUpDn
  1875.       ZElapsedTime = CVI(MID$(ZUserRecord$,127,2))
  1876.       ZFileName$ = "DOUT" + ZNodeID$ + ".DEF"
  1877.       CALL FindIt (ZFileName$)
  1878.       IF NOT ZOK THEN _
  1879.          GOTO 63197
  1880. 63105 IF EOF(2) THEN _
  1881.          GOTO 63195
  1882.       CALL ReadParms (ZOutTxt$(),2,1)
  1883.       IF ZErrCode > 0 THEN _
  1884.          GOTO 63115
  1885.       IF LEN(ZOutTxt$(1)) < 2 THEN _
  1886.          GOTO 63105
  1887.       ZUserIn$ = LEFT$(ZOutTxt$(1),2) + ","
  1888.       WasX = INSTR("SL,UR,",ZUserIn$)
  1889.       IF WasX = 0 THEN _
  1890.          GOTO 63105
  1891.       WasX = WasX\3 + 1
  1892.       ON WasX GOTO 63110,63115
  1893.       GOTO 63105
  1894. 63110 WasX$ = LEFT$(ZOutTxt$(2),1)         ' ZWasSL = Security Level
  1895.       CALL CheckInt (ZOutTxt$(2))
  1896.       IF ZErrCode > 0 THEN _
  1897.          GOTO 63105
  1898.       IF WasX$ = "+" OR WasX$ = "-" THEN _
  1899.          ZWasA = ZUserSecLevel + ZTestedIntValue _
  1900.       ELSE ZWasA = ZTestedIntValue
  1901.       IF ZWasA < ZSysopSecLevel THEN _
  1902.          ZAdjustedSecurity = (ZWasA <> ZUserSecLevel) : _
  1903.          IF ZAdjustedSecurity THEN _
  1904.             ZUserSecLevel = ZWasA : _
  1905.             MID$(ZUserRecord$,47,2) = MKI$(ZWasA) : _
  1906.             CALL QuickTPut1 ("Security changed to" + STR$(ZWasA)) : _
  1907.             CALL UpdtCalr ("Door reset security to "+STR$(ZWasA),2)
  1908.       GOTO 63105
  1909. 63115 IF LEN(ZOutTxt$(1)) < 7 THEN _
  1910.          GOTO 63105
  1911.       IF MID$(ZOutTxt$(1),3,1) <> "(" THEN _
  1912.          GOTO 63105
  1913.       WasX = INSTR(4,ZOutTxt$(1),":")
  1914.       IF WasX < 1 THEN _
  1915.          GOTO 63105
  1916.       CALL CheckInt (MID$(ZOutTxt$(1),4,WasX-4))
  1917.       IF ZErrCode > 0 THEN _
  1918.          GOTO 63105
  1919.       IF ZTestedIntValue > 128 OR ZTestedIntValue < 1 THEN _
  1920.          GOTO 63105
  1921.       ZWasA = ZTestedIntValue
  1922.       CALL CheckInt (MID$(ZOutTxt$(1),WasX+1))
  1923.       IF ZErrCode > 0 OR ZTestedIntValue < 1 OR ZTestedIntValue > 128 THEN _
  1924.          GOTO 63105
  1925.       MID$(ZUserRecord$,ZWasA,ZTestedIntValue) = LEFT$(ZOutTxt$(2) + _
  1926.          SPACE$(ZTestedIntValue),ZTestedIntValue)
  1927.       CALL UpdtCalr ("Door set UR"+STR$(ZWasA)+":"+STR$(ZTestedIntValue)+" to <"+ZOutTxt$(2)+">",2)
  1928.       GOTO 63105
  1929. 63195 CALL KillWork (ZFileName$)
  1930.       ZErrCode = 0
  1931.       PUT 5,ZUserFileIndex
  1932. 63197 ZSubParm = 8
  1933.       CALL FileLock
  1934.       END SUB
  1935. 63200 ' $SUBTITLE: 'WildCard -- Matches string to a pattern'
  1936. ' $PAGE
  1937. '  NAME    -- WildCard
  1938. '
  1939. '  INPUTS  -- PARAMETER             MEANING
  1940. '             Pattern$           PATTERN TO CHECK
  1941. '             Strng$             STRING TO FIE
  1942. '
  1943. '  OUTPUTS -- ZOK                True IF MATCH Found
  1944. '                                False IF No MATCH WAS Found
  1945. '
  1946. '  PURPOSE  Determine whether a string is an instance in a pattern
  1947. '           supported patterns are only "?" which requires a
  1948. '           character but can be any, and "*" which matches any-
  1949. '           thing, including a null string.  Anything else in a
  1950. '           sting must be an exact match.  Supports reverse
  1951. '           wildcards.
  1952. '
  1953. '
  1954.       SUB WildCard (Pattern$,Strng$) STATIC
  1955. 63285 ZOK = ZTrue
  1956.       PatPos = 0
  1957.       StrPos = 0
  1958.       Inc = 1
  1959.       WasKT = 0
  1960.       WasP = LEN(Pattern$)
  1961.       WasL = LEN(Strng$)
  1962. 63286 PatPos = PatPos + Inc
  1963.       StrPos = StrPos + Inc
  1964.       WasKT = WasKT + 1
  1965.       IF WasKT > WasL THEN _
  1966.          GOTO 63288
  1967.       ZUserIn$ = MID$(Pattern$,PatPos,1)
  1968.       IF ZUserIn$ = "*" THEN _
  1969.          GOTO 63289
  1970. 63287 IF ZUserIn$ <> "?" AND MID$(Strng$,StrPos,1) <> ZUserIn$ THEN _
  1971.          ZOK = ZFalse : _
  1972.          EXIT SUB
  1973.       GOTO 63286
  1974. 63288 IF PatPos >= LEN(Pattern$) OR PatPos < 1 THEN _
  1975.          EXIT SUB
  1976.       IF MID$(Pattern$,PatPos,1) <> "*" THEN _
  1977.          ZOK = ZFalse : _
  1978.          EXIT SUB
  1979. 63289 IF PatPos <> WasP THEN _   ' Reverse search
  1980.          Inc = -1 : _
  1981.          WasP = PatPos : _
  1982.          PatPos = LEN(Pattern$) + 1 : _
  1983.          StrPos = LEN(Strng$) + 1 : _
  1984.          WasKT = 0 : _
  1985.          GOTO 63286
  1986.       END SUB
  1987. 63300 ' $SUBTITLE: 'BreakFileName - sub to split file name into components'
  1988. ' $PAGE
  1989. '
  1990. '  NAME    -- BreakFileName
  1991. '
  1992. '  INPUTS  -- PARAMETER                    MEANING
  1993. '             FileSpec$        FULL NAME OF FILE
  1994. '             ForJoining       True IF WANT PARTS FORMATTED FOR
  1995. '                                           FORMING FILE NAMES
  1996. '  OUTPUTS -- DrvPath$         DRIVE AND PATH
  1997. '             Prefix$          PREFIX OF FILE NAME
  1998. '             Extension$       EXTENSION OF FILE NAME
  1999. '
  2000. ' (E.G. "C:\RBBS\ARCE.COM" HAS "C:\RBBS" AS DRIVE AND PATH,
  2001. '                              "ARCE"    AS PREFIX OF THE FILE NAME, AND
  2002. '                              "COM"     AS THE EXTENSION OF THE FILE NAME.
  2003. '
  2004. ' JOINED FORMAT IS C:\RBBS\,ARCE,.COM
  2005. '
  2006. '  PURPOSE -- To break a file name into its component parts
  2007. '             of drive/path, prefix, and extension
  2008. '
  2009. '
  2010.       SUB BreakFileName (PassedFileSpec$,DrvPath$,Prefix$,Extension$,ForJoining) STATIC
  2011.       FileSpec$ = PassedFileSpec$
  2012.       CALL AllCaps (FileSpec$)
  2013.       DrvPath$ = ""
  2014.       Prefix$ = ""
  2015.       Extension$ = ""
  2016.       WasL = LEN(FileSpec$)
  2017.       IF WasL < 1 THEN _
  2018.          EXIT SUB
  2019.       CALL FindLast (FileSpec$,"\",WasX,WasY)
  2020.       IF WasX < 1 THEN _
  2021.          IF MID$(FileSpec$,2,1) = ":" THEN _
  2022.             DrvPath$ = LEFT$(FileSpec$,2) : _
  2023.             ZWasS = 3 _
  2024.          ELSE ZWasS = 1 _
  2025.       ELSE DrvPath$ = LEFT$(FileSpec$,WasX) : _
  2026.            ZWasS = WasX + 1
  2027.       WasX = INSTR(ZWasS,FileSpec$ + ".",".")
  2028.       IF WasX < WasL THEN _
  2029.          Extension$ = MID$(FileSpec$,WasX)
  2030.       IF ZWasS <= WasL THEN _
  2031.          IF WasX >= ZWasS THEN _
  2032.             Prefix$ = MID$(FileSpec$,ZWasS,WasX - ZWasS)
  2033.       IF ForJoining THEN _
  2034.          EXIT SUB
  2035.       IF WasY > 1 THEN _
  2036.          DrvPath$ = LEFT$(DrvPath$, LEN(DrvPath$) - 1)
  2037.       IF LEN(Extension$) > 0 THEN _
  2038.          Extension$ = MID$(Extension$, 2)
  2039.       END SUB
  2040. 63310 ' $SUBTITLE: 'RestoreCom - sub to restore comm port'
  2041. ' $PAGE
  2042. '
  2043. '  NAME    -- RestoreCom
  2044. '
  2045. '  INPUTS  -- none
  2046. '
  2047. '  OUTPUTS -- none
  2048. '
  2049. '  PURPOSE -- To restore communications port after an external
  2050. '             program may have left it in altered state
  2051. '
  2052.       SUB RestoreCom STATIC
  2053.       Parity$ = MID$(",N,8,1,E,7,1",7 + 6 * ZEightBit,6)
  2054.       IF ZLocalUser THEN _
  2055.          EXIT SUB
  2056.       CALL SetBaud
  2057.       IF NOT ZFossil THEN _
  2058.          CALL OpenCom(ZTalkToModemAt$,Parity$)
  2059.       END SUB
  2060. 63320 ' $SUBTITLE: 'ShellExit - sub to shell out from RBBS'
  2061. ' $PAGE
  2062. '
  2063. '  NAME    -- ShellExit
  2064. '
  2065. '  INPUTS  -- ShellTem$     String to invoke shell with
  2066. '
  2067. '  OUTPUTS -- none
  2068. '
  2069. '  PURPOSE -- Delay so that strings can finish printing.  Restore comm
  2070. '             port on return
  2071. '
  2072.       SUB ShellExit (ShellTem$) STATIC
  2073.       CALL DelayTime (8 + ZBPS)
  2074.       IF NOT ZLocalUser THEN _
  2075.          IF ZFossil THEN _
  2076.             CALL FOSExit(ZComPort) _
  2077.          ELSE CLOSE 3 : _
  2078.               OUT ZModemCntlReg,INP(ZModemCntlReg) OR 1
  2079.       CLOSE 2
  2080.       CALL MetaGSR (ShellTem$,ZFalse)
  2081.       SHELL ShellTem$
  2082.       IF ZFossil THEN _
  2083.          IF NOT ZLocalUser THEN _
  2084.             CALL FOSinit(ZComPort,Result) : _
  2085.             IF Result = -1 THEN _
  2086.                CALL PScrn("ERROR INIT FOSSIL AFT EXTERNAL") : _
  2087.                SYSTEM
  2088.       CALL DelayTime (2)
  2089.       CALL RestoreCom
  2090.       END SUB
  2091. 63330 ' $SUBTITLE: 'ReadMacro - sub to read macro'
  2092. ' $PAGE
  2093. '
  2094. '  NAME    -- ReadMacro
  2095. '
  2096. '  INPUTS  -- PARAMETER             MEANING
  2097. '
  2098. '  OUTPUTS -- ZOutTxt$               LINE TO PROCESS IN MACRO
  2099. '             ZMacroActive           FLAG WHETHER IN A MACRO
  2100. '
  2101. '  PURPOSE -- Reads in a line from macro file (#6) and processes
  2102. '             macro commands, which are:
  2103. '             *0 - display what follows, no carriage return
  2104. '             *1 - display what follows with carriage return
  2105. '             *B - display block that follows
  2106. '             *F - display File
  2107. '             WT - wait specified # of seconds
  2108. '             >> - append following block to specified file
  2109. '             ST - stack following (with carriage return)
  2110. '             ON - define case
  2111. '             == - case value that applies to following block
  2112. '             M! - execute following macro
  2113. '             M@ - abort macro processing
  2114. '             EY - Echo on (yes)
  2115. '             EN - Echo off (no)
  2116. '             /* - comment line skipped in processing
  2117. '             TK - Turbo key on (if user preference)
  2118. '             << - Read from file into a form
  2119. '             := - Assign value to work variable
  2120. '             LO - Set the location of a file
  2121. '
  2122.       SUB ReadMacro STATIC
  2123.       IF ZMacroTemplate$ <> "" THEN _
  2124.          GOTO 63392
  2125.       IF ZDistantTGet = 2 THEN _
  2126.          GOTO 63349
  2127. 63336 GOSUB 63395
  2128.       IF NOT ZMacroActive THEN _
  2129.          ZMacroEcho = ZTrue : _
  2130.          EXIT SUB
  2131.       IF CompareVar > 0 THEN _
  2132.          IF NOT CaseExecute THEN _
  2133.             IF LEFT$(ZOutTxt$,3) = ZSmartTextCode$+"==" THEN _
  2134.                WasX$ = RIGHT$(ZOutTxt$,LEN(ZOutTxt$)-3) : _
  2135.                GOTO 63370 _
  2136.             ELSE IF LEFT$(ZOutTxt$,7) = ZSmartTextCode$ + "END ON" THEN _
  2137.                     CompareVar = 0 : _
  2138.                     GOTO 63336 _
  2139.                   ELSE GOTO 63336
  2140.       IF LEN(ZOutTxt$) < 3 THEN _
  2141.          GOTO 63398
  2142.       WasX$ = RIGHT$(ZOutTxt$,LEN(ZOutTxt$)-3)
  2143.       IF LEFT$(ZOutTxt$,1) <> ZSmartTextCode$ THEN _
  2144.          GOTO 63398
  2145.       CALL CheckInt (MID$(ZOutTxt$,2))
  2146.       IF ZErrCode > 0 THEN _
  2147.          GOTO 63398
  2148.       IF ZTestedIntValue > 0 AND ZTestedIntValue <= ZMaxWorkVar THEN _
  2149.          ZOutTxt$ = WasX$ : _  ' Macro command ask
  2150.          ZForceKeyboard = ZTrue : _
  2151.          ZMacroSave = ZTestedIntValue : _
  2152.          ZLinesPrinted = 1 : _
  2153.          ZNonStop = (ZPageLength < 1) : _
  2154.          EXIT SUB
  2155.       ON (1+INSTR("*0*1*B*FWT>>STON==M!M@EYEN/*TK<<:=LVNVCVLO",MID$(ZOutTxt$,2,2)))\2 GOTO _
  2156.          63345, _  ' Display with no Carriage Return
  2157.          63347, _  ' Display with Carriage Return
  2158.          63340, _  ' Display Block
  2159.          63348, _  ' Display File
  2160.          63343, _  ' Wait # of seconds
  2161.          63350, _  ' Append to file
  2162.          63355, _  ' Stack
  2163.          63360, _  ' Case
  2164.          63370, _  ' Case Comparison
  2165.          63375, _  ' Macro execute
  2166.          63380, _  ' Macro Abort
  2167.          63383, _  ' Macro Echo on
  2168.          63385, _  ' Macro Echo off
  2169.          63336, _  ' Macro Comment
  2170.          63387, _  ' Turbo Key allowed
  2171.          63390, _  ' Form read
  2172.          63362, _  ' Assign value to work var
  2173.          63363, _  ' LV list verify
  2174.          63364, _  ' NV number verify
  2175.          63364, _  ' CV character verify
  2176.          63367     ' LO assign file location
  2177.       GOTO 63398
  2178. 63338 ZOutTxt$ = WasX$
  2179. 63339 ZSubParm = 4
  2180.       CALL TPut
  2181.       RETURN
  2182. 63340 WasX$ = ZSmartTextCode$ + "END"  ' Print Block
  2183.       GOSUB 63395
  2184.       WHILE ZMacroActive AND LEFT$(ZOutTxt$,4) <> WasX$
  2185.          GOSUB 63339
  2186.          CALL SkipLine (1)
  2187.          GOSUB 63395
  2188.       WEND
  2189.       GOTO 63336
  2190. 63343 CALL CheckInt (WasX$)      ' Delay
  2191.       IF ZErrCode = 0 THEN _
  2192.          CALL DelayTime (ZTestedIntValue)
  2193.       GOTO 63336
  2194. 63345 GOSUB 63338               ' Print Line
  2195.       GOTO 63336
  2196. 63347 GOSUB 63338
  2197.       CALL SkipLine (1)
  2198.       GOTO 63336
  2199. 63348 CALL Trim (WasX$)            ' Print File
  2200.       CALL FindItX (WasX$,2)
  2201.       IF NOT ZOK THEN _
  2202.          GOTO 63336
  2203.       ZLinesPrinted = 1
  2204.       ZNo = ZFalse
  2205.       ZNonStop = (ZNonStop OR ZPageLength < 1)
  2206. 63349 WHILE (NOT EOF(2) AND (NOT ZNo) AND (ZNonStop OR (ZLinesPrinted < ZPageLength)) AND (ZSubParm > -1)) ' KG083101
  2207.          CALL ReadDir (2,1)
  2208.          GOSUB 63396
  2209.          ZSubParm = 5
  2210.          CALL TPut
  2211.       WEND
  2212.       ZDistantTGet = 0
  2213.       IF ZSubParm < 0 THEN _
  2214.          EXIT SUB
  2215.       IF EOF(2) OR ZNo THEN _
  2216.          CLOSE 2 : _
  2217.          ZNo = ZFalse : _
  2218.          GOTO 63336
  2219.       ZDistantTGet = 2
  2220.       CALL PauseExit
  2221.       EXIT SUB
  2222. 63350 ZWasEN$ = WasX$            ' Append to file
  2223.       WasX = INSTR(ZWasEN$," /FL")
  2224.       OverStrike = (WasX > 0)
  2225.       IF OverStrike THEN _
  2226.          ZWasEN$ = LEFT$(ZWasEN$,WasX-1) + RIGHT$(ZWasEN$,LEN(ZWasEN$)-WasX-3)
  2227.       CALL Trim (ZWasEN$)
  2228.       CALL LockAppend
  2229.       IF ZErrCode > 0 THEN _
  2230.          GOTO 63352
  2231.       GOSUB 63395
  2232.       WasX$ = ZSmartTextCode$ + "END"
  2233.       WHILE ZMacroActive AND LEFT$(ZOutTxt$,4) <> WasX$
  2234.          CALL PrintWorkA (ZOutTxt$)
  2235.          GOSUB 63395
  2236.       WEND
  2237. 63352 CALL UnLockAppend
  2238.       OverStrike = ZFalse
  2239.       GOTO 63336
  2240. 63355 ZCommPortStack$ = ZCommPortStack$ + WasX$ + ZCarriageReturn$
  2241.       GOTO 63336
  2242. 63360 CompareVar = VAL(WasX$)
  2243.       CALL AllCaps (WasX$)
  2244.       IF CompareVar < 1 OR CompareVar > ZMaxWorkVar THEN _
  2245.          CompareVar = 0
  2246.       GOTO 63336
  2247. 63362 CALL Trim (WasX$)
  2248.       CALL CheckInt (WasX$)
  2249.       WasX = INSTR(WasX$," ")
  2250.       IF WasX > 0 AND ZTestedIntValue > 0 AND ZTestedIntValue <= ZMaxWorkVar THEN _
  2251.          ZGSRAra$(ZTestedIntValue) = RIGHT$(WasX$,LEN(WasX$)-WasX)
  2252.       GOTO 63336
  2253. 63363 ZVerifyList$ = WasX$
  2254.       CALL Trim (ZVerifyList$)
  2255.       GOTO 63365
  2256. 63364 CALL Trim (WasX$)
  2257.       WasX = INSTR(WasX$," ")
  2258.       IF WasX = 0 THEN _
  2259.          GOTO 63336
  2260.       ZVerifyLow$ = LEFT$(WasX$,WasX-1)
  2261.       ZVerifyHigh$ = RIGHT$(WasX$,LEN(WasX$)-WasX)
  2262.       CALL Trim (ZVerifyLow$)
  2263.       CALL Trim (ZVerifyHigh$)
  2264.       ZVerifyNumeric = (MID$(ZOutTxt$,2,1) = "N")
  2265. 63365 ZVerifying = ZTrue
  2266.       GOTO 63336
  2267. 63367 CALL TRIM (WasX$)
  2268.       ZFileLocation$ = WasX$
  2269.       GOTO 63336
  2270. 63370 IF CompareVar = 0 THEN _     ' Compare Case
  2271.          GOTO 63336
  2272.       ZWasDF$ = ZGSRAra$(CompareVar)
  2273.       CALL AllCaps (ZWasDF$)
  2274.       CaseExecute = (WasX$ = ZWasDF$)
  2275.       GOTO 63336
  2276. 63375 CALL Trim (WasX$)           ' Execute Macro
  2277.       CALL Macro (WasX$,WasX)
  2278.       GOTO 63336
  2279. 63380 ZMacroActive = ZFalse     ' Abort Macro
  2280.       GOTO 63398
  2281. 63383 ZMacroEcho = ZTrue
  2282.       GOTO 63336
  2283. 63385 ZMacroEcho = ZFalse
  2284.       GOTO 63336
  2285. 63387 ZTurboKey = -ZTurboKeyUser   'TK Turbo Key
  2286.       GOTO 63336
  2287. 63390 ZUserIn$ = ZOutTxt$
  2288.       ZUserIn$(5) = ""
  2289.       ZUserIn$(6) = ""
  2290.       ZWasQ = 1
  2291.       ZStoreParseAt = 1
  2292.       CALL ParseIt
  2293.       IF ZWasQ < 4 THEN _
  2294.          GOTO 63336
  2295.       WasX$ = ZSmartTextCode$ + "END"
  2296.       GOSUB 63397
  2297.       ZMacroTemplate$ = ""
  2298.       WHILE ZMacroActive AND LEFT$(ZOutTxt$,4) <> WasX$
  2299.          ZMacroTemplate$ = ZMacroTemplate$ + ZOutTxt$ + ZCrLf$
  2300.          GOSUB 63397
  2301.       WEND
  2302.       WasX = VAL(ZUserIn$(4))
  2303.       VarLen = (ZUserIn$(3) <> "/F")
  2304.       CALL FindIt (ZUserIn$(2))
  2305.       IF (WasX < 1) OR (NOT ZOK) OR (VarLen AND WasX > ZMaxWorkVar) THEN _
  2306.          ZMacroTemplate$ = "" : _
  2307.          GOTO 63336
  2308.       PauseEachRec = (ZUserIn$(6) = "/1")
  2309. 63392 CALL FormRead (ZMacroTemplate$,ZUserIn$(2),NOT VarLen,WasX,(ZUserIn$(5) = "/FL"),PauseEachRec)
  2310.       IF ZMacroTemplate$ <> "" THEN _
  2311.          EXIT SUB _
  2312.       ELSE GOTO 63336
  2313. 63395 GOSUB 63397
  2314.       GOSUB 63396
  2315.       RETURN
  2316. 63396 CALL SmartText (ZOutTxt$,ZFalse, OverStrike)
  2317.       CALL MetaGSR (ZOutTxt$,OverStrike)
  2318.       RETURN
  2319. 63397 IF EOF(6) THEN _         ' Read next line in macro
  2320.          ZMacroActive = ZFalse _
  2321.       ELSE CALL ReadDir (6,1) : _
  2322.            ZMacroActive = (ZErrCode = 0)
  2323.       RETURN
  2324. 63398 END SUB    ' Not Macro command - pass to normal processing
  2325. 63400 ' $SUBTITLE: 'LockAppend - prepares for file append'
  2326. ' $PAGE
  2327. '
  2328. '  NAME    -- LockAppend
  2329. '
  2330. '  INPUTS  -- ZWasEN$            Name of file to append to
  2331. '
  2332. '  OUTPUTS -- none
  2333. '
  2334. '  PURPOSE -- Locks and opens file to append to
  2335. '
  2336.       SUB LockAppend STATIC
  2337.       WasBX = &H4
  2338.       ZSubParm = 9
  2339.       CALL FileLock
  2340.       ZErrCode = 0
  2341.       CALL OpenWorkA (ZWasEN$)
  2342.       END SUB
  2343. 63410 ' $SUBTITLE: 'UnLockAppend - cleans up after file append'
  2344. ' $PAGE
  2345. '
  2346. '  NAME    -- UnLockAppend
  2347. '
  2348. '  INPUTS  -- none
  2349. '
  2350. '  OUTPUTS -- none
  2351. '
  2352. '  PURPOSE -- Unlocks and close file appending to
  2353. '
  2354.       SUB UnLockAppend STATIC
  2355.       WasBX = &H4
  2356.       ZSubParm = 10
  2357.       CALL FileLock
  2358.       CLOSE 2
  2359.       END SUB
  2360. 63420 ' $SUBTITLE: 'FormRead - Reads from a file into a form'
  2361. ' $PAGE
  2362. '
  2363. '  NAME    -- FormRead
  2364. '
  2365. '  INPUTS  -- Template$      Display formvoke shell with
  2366. '             FilName$       Data file to get values from
  2367. '             FixedLength    Whether file is fixed length
  2368. '             DataVar       # bytes data if fixed length; # fields
  2369. '                              if variable length
  2370. '             OverStrike     Whether typeover into form or insert
  2371. '             RecPause      Whether pause after every record displayed
  2372. '                               otherwise when screen fills
  2373. '  OUTPUTS -- (displays data base records)
  2374. '
  2375. '  PURPOSE -- Allows field oriented data base data to be displayed
  2376. '               in a human readable format by substituting field
  2377. '               data into template or form
  2378. '
  2379.       SUB FormRead (Template$,FilName$,FixedLength,DataVar,OverStrike,RecPause) STATIC
  2380. 63422 IF EOF(2) OR ZNo OR (ZErrCode > 0) OR (ZSubParm < 0) THEN _
  2381.          Template$ = "" : _
  2382.          EXIT SUB
  2383.       IF FixedLength THEN _
  2384.          CALL ReadDir (2,1) : _
  2385.          ZGSRAra$(1) = ZOutTxt$ _
  2386.       ELSE CALL ReadParms (ZGSRAra$(),DataVar,1)
  2387.       WasX$ = Template$
  2388.       CALL SmartText (WasX$,ZTrue,OverStrike)
  2389.       CALL MetaGSR (WasX$,OverStrike)
  2390.       CALL BufAsUnit (WasX$)
  2391.       IF RecPause OR (ZPageLength > 0 AND (ZLinesPrinted >= ZPageLength-1)) THEN _
  2392.          CALL PauseExit : _
  2393.          EXIT SUB
  2394.       GOTO 63422
  2395.       END SUB
  2396. 63440 ' $SUBTITLE: 'BufAsUnit - prints string with no pauses'
  2397. ' $PAGE
  2398. '
  2399. '  NAME    -- BufAsUnit
  2400. '
  2401. '  INPUTS  -- Strng$     String to print
  2402. '
  2403. '  OUTPUTS -- none
  2404. '
  2405. '  PURPOSE -- Prints string with embedded carriage returns.
  2406. '             Will never pause.  Used to print when can't call TGet
  2407. '
  2408.       SUB BufAsUnit (Strng$) STATIC
  2409.       WasL = LEN(Strng$)
  2410.       IF WasL < 1 THEN _
  2411.          EXIT SUB
  2412.       StartByte = 1
  2413. 63450 CRat = INSTR(StartByte,Strng$,ZCarriageReturn$)
  2414.       IF CRat > 0 AND CRat < WasL THEN _
  2415.          CRFound = (MID$(Strng$,CRat + 1,1) = ZLineFeed$) _
  2416.       ELSE CRFound = ZFalse
  2417.       EOLlen = -2 * CRFound
  2418.       IF CRFound THEN _
  2419.          EOD = CRat _
  2420.       ELSE EOD = WasL + 1
  2421.       NumBytes = EOD - StartByte
  2422.       ZOutTxt$ = MID$(Strng$,StartByte,NumBytes)
  2423.       ZSubParm = 4
  2424.       CALL TPut
  2425.       CALL SkipLine (-(CRFound))
  2426.       IF ZRet THEN _
  2427.          EXIT SUB
  2428.       StartByte = EOD + EOLlen
  2429.       IF StartByte <= WasL THEN _
  2430.          GOTO 63450
  2431.       END SUB
  2432. 63460 ' Check if macro exists and execute if does
  2433.       SUB MacroExe (Strng$) STATIC
  2434.       CALL Trim (Strng$)
  2435.       CALL Macro (Strng$,Found)
  2436.       IF NOT Found THEN _
  2437.          EXIT SUB
  2438.       CALL FdMacExe
  2439.       END SUB
  2440. 63462 ' Unconditionally executes a macro
  2441.       SUB FdMaCExe STATIC
  2442.       ZOutTxt$ = ""
  2443.       ZMacroEcho = ZFalse
  2444.       ZSubParm = 1
  2445.       CALL TGet
  2446.       END SUB
  2447. 63465 ' Forces a keyboard pause inside a macro
  2448.       SUB PauseExit STATIC
  2449.       ZSubParm = 4
  2450.       ZTurboKey = -ZTurboKeyUser
  2451.       ZOutTxt$ = ZMorePrompt$ + ">" + MID$("? ! ",2*ZTurboKey+1,2)
  2452.       ZForceKeyboard = ZTrue
  2453.       ZNoAdvance = ZTrue
  2454.       CALL TPut
  2455.       ZLinesPrinted = 0
  2456.       ZUserIn$ = ""
  2457.       END SUB
  2458. 63470 ' $SUBTITLE: 'SetPrompt - sub to set prompts based on user security'
  2459. ' $PAGE
  2460. '
  2461. '  NAME    -- SetPrompt
  2462. '
  2463. '  INPUTS  -- PARAMETER           MEANING
  2464. '             ZBegMain          POSITION START OF MAIN CMDS
  2465. '             ZBegFile          POSITION START OF FILE CMDS
  2466. '             ZBegUtil          POSITION START OF UTIL CMDS
  2467. '             ZBegLibrary       POSITION START OF Library CMDS
  2468. '
  2469. '  OUTPUTS -- PRESENT.OPTS$         DISPLAY WHAT USER CAN DO (1st)
  2470. '             CALLERS.OPTS$         DISPLAY WHAT USER CAN DO (2nd)
  2471. '             ZMainOpts$            MAIN OPTS USER CAN DO
  2472. '             ZFileOpts$            FILE OPTS USER CAN DO
  2473. '             ZUtilOpts$            UTIL OPTS USER CAN DO
  2474. '             ZLibOpts$         Library OPTS USER CAN DO
  2475. '
  2476. '  PURPOSE -- Sets command line display of what user can do by
  2477. '             section and display of what all user can do
  2478. '
  2479.       SUB SetPrompt STATIC
  2480.       First = ZBegMain
  2481.       Last = ZBegFile - 1
  2482.       CALL SetOpts (ZMainOpts$,ZInvalidMainOpts$,First,Last)
  2483.       First = ZBegFile
  2484.       Last = ZBegUtil - 1
  2485.       CALL SetOpts (ZFileOpts$,ZInvalidFileOpts$,First,Last)
  2486.       First = ZBegUtil
  2487.       Last = ZBegLibrary - 1
  2488.       CALL SetOpts (ZUtilOpts$,ZInvalidUtilOpts$,First,Last)
  2489.       First = ZBegLibrary
  2490.       Last = ZBegLibrary + 6
  2491.       CALL SetOpts (ZLibOpts$,ZInvalidLibraryOpts$,First,Last)
  2492.       First = 50
  2493.       Last = 56
  2494.       CALL SetOpts (SysOpt$,ZInvalidSysOpts$,First,Last)
  2495.       First = 46
  2496.       Last = 49
  2497.       CALL SetOpts (GlobalOpts$,InvalidGlobalOpts$,First,Last)
  2498.       IF LEN(SysOpt$) > 0 THEN _
  2499.          ZSystemOpts$ = "Sysop: " + _
  2500.                         SysOpt$
  2501.       ZMainOpts$ = GlobalOpts$ + ZMainOpts$ + _
  2502.                    MID$(ZAllOpts$,INSTR(ZOrigCommands$,"G"),1)
  2503.       ZFileOpts$ = GlobalOpts$ + _
  2504.                    ZFileOpts$
  2505.       ZUtilOpts$ = GlobalOpts$ + _
  2506.                    ZUtilOpts$
  2507.       ZLibOpts$ = GlobalOpts$ + _
  2508.                       ZLibOpts$
  2509.       CALL SortString (SysOpt$)
  2510.       CALL SortString (ZMainOpts$)
  2511.       ZMainOpts$ = ZMainOpts$ + _
  2512.                    SysOpt$
  2513.       CALL SortString (ZFileOpts$)
  2514.       CALL SortString (ZUtilOpts$)
  2515.       CALL SortString (ZLibOpts$)
  2516.       CALL AddCommas (ZMainOpts$)
  2517.       CALL AddCommas (ZFileOpts$)
  2518.       CALL AddCommas (ZUtilOpts$)
  2519.       CALL AddCommas (ZLibOpts$)
  2520.       ZDirPrompt$ = "What directory(s) (" + _
  2521.          MID$("U)pload,A)ll,L)ist,E)xtended +/-, [Q]uit)",8 * (ZUserSecLevel => ZMinSecToView) + 9)
  2522.       ZQuitPromptExpert$ = "QUIT C,S, or to F,[M],U,@"
  2523.       ZQuitPromptNovice$ = "QUIT C)onference, S)ession or to section " + _
  2524.                             "F)ile, [M]ain, U)til or @)Library"
  2525.       ZQuitList$ = "FMUS@C"
  2526.       IF ZUserSecLevel < ZOptSec(18) THEN _
  2527.          ZQuitPromptExpert$ = LEFT$(ZQuitPromptExpert$,23) : _
  2528.          ZQuitPromptNovice$ = LEFT$(ZQuitPromptNovice$,61) : _
  2529.          MID$(ZQuitList$,5) = " "
  2530.       IF ZUserSecLevel < ZOptSec(15) THEN _
  2531.          ZQuitPromptExpert$ = LEFT$(ZQuitPromptExpert$,22) + _
  2532.                                MID$(ZQuitPromptExpert$,25) : _
  2533.          ZQuitPromptNovice$ = LEFT$(ZQuitPromptNovice$,56) + _
  2534.                                MID$(ZQuitPromptNovice$,63) : _
  2535.          MID$(ZQuitList$,3,1) = " "
  2536.       IF ZUserSecLevel < ZOptSec(6) THEN _
  2537.          ZQuitPromptExpert$ = LEFT$(ZQuitPromptExpert$,16) + _
  2538.                                MID$(ZQuitPromptExpert$,19) : _
  2539.          ZQuitPromptNovice$ = LEFT$(ZQuitPromptNovice$,41) + _
  2540.                                MID$(ZQuitPromptNovice$,49) : _
  2541.          MID$(ZQuitList$,1,1) = " "
  2542.       CALL SetSection
  2543.       END SUB
  2544. 63480 ' $SUBTITLE: 'NoPath - detects whether string has path'
  2545. ' $PAGE
  2546. '
  2547. '  NAME    -- NoPath
  2548. '
  2549. '  INPUTS  -- Strng$     String to check
  2550. '
  2551. '  OUTPUTS -- HAS.NONE   True if has no path
  2552. '
  2553. '  PURPOSE -- Detects whether have path.  Used when shouldn't
  2554. '             be any
  2555. '
  2556.       SUB NoPath (Strng$,HasPath) STATIC
  2557.       CALL BreakFileName (Strng$,DrvPath$,Prefix$,Ext$,ZFalse)
  2558.       HasPath = (DrvPath$ <> "")
  2559.       END SUB
  2560. 63490 ' $SUBTITLE: 'FindIt - Determine whether file exists'
  2561. ' $PAGE
  2562. '
  2563. '  NAME    -- FindIt
  2564. '
  2565. '  INPUTS  -- FilName$   File name to check
  2566. '
  2567. '  OUTPUTS -- ZOK         True if file exists.  Opened as #2 if does
  2568. '
  2569. '  PURPOSE -- Determine whether file exists and open as standard work
  2570. '             file if it does (#2)
  2571. '
  2572.       SUB FindIt (FilName$) STATIC
  2573.       CALL FindItX (FilName$,2)
  2574.       END SUB
  2575. 63495 ' $SUBTITLE: 'TimeBack - Give time back to the user'
  2576. ' $PAGE
  2577. '
  2578. '  NAME    -- TimeBack
  2579. '
  2580. '  INPUTS  -- Index    = 1    Set start of time (begin give back)
  2581. '                      = 2    Give back time from defined start
  2582. '
  2583. '  OUTPUTS -- ZTimeCredits!         Number of seconds to credit with
  2584. '             ZSecsPerSession!  Number of seconds in current session
  2585. '
  2586. '  PURPOSE -- Give time back to the user (e.g. sysop initiated chat)
  2587. '
  2588.       SUB TimeBack (Index) STATIC
  2589.       IF Index = 1 THEN _
  2590.          CALL TimeRemain (MinsRemaining) : _
  2591.          ZWasQ! = ZSecsUsedSession! : _
  2592.          EXIT SUB
  2593.       CALL TimeRemain (MinsRemaining)
  2594.       WasX! = (ZSecsUsedSession! - ZWasQ!)
  2595.       ZTimeCredits! = ZTimeCredits! + WasX!
  2596.       END SUB
  2597. 63500 ' $SUBTITLE: 'CmdStackPushPop - Save/restore command stack'
  2598. ' $PAGE
  2599. '
  2600. '  NAME    -- CmdStackPushPop
  2601. '
  2602. '  INPUTS  -- Index    = 1    Save command stack
  2603. '                      = 2    Restore command stack
  2604. '             ZAnsIndex
  2605. '             ZLastIndex
  2606. '             ZUserIn$()
  2607. '
  2608. '  OUTPUTS -- ZUserIn$()                  Stacked commands
  2609. '             ZAnsIndex
  2610. '             ZLastIndex
  2611. '
  2612. '  PURPOSE -- Save restore a command stack list when need to input
  2613. '             another list in middle of previous list processing
  2614. '
  2615.       SUB CmdStackPushPop (Index) STATIC
  2616.       IF Index = 1 THEN _
  2617.          OrigLastIndex = ZLastIndex : _  ' save
  2618.          OrigIndex = ZAnsIndex : _
  2619.          FOR WasI = 1 TO OrigLastIndex : _
  2620.              ZOutTxt$(WasI) = ZUserIn$(WasI) : _
  2621.          NEXT : _
  2622.          EXIT SUB
  2623.       ZLastIndex = OrigLastIndex        ' restore
  2624.       ZAnsIndex = OrigIndex
  2625.       FOR WasI = 1 TO OrigLastIndex
  2626.          ZUserIn$(WasI) = ZOutTxt$(WasI)
  2627.       NEXT
  2628.       END SUB
  2629. 63510 ' $SUBTITLE: 'VerifyAns - edits an answer'
  2630. ' $PAGE
  2631. '
  2632. '  NAME    -- VerifyAns
  2633. '                                  MEANING
  2634. '  INPUTS  -- ZVerifying      Whether verifying
  2635. '             ZUserIn$(1)     Response verifying
  2636. '             ZVerifyList$    List of appropriate answers.  1st
  2637. '                                char is what separates answers
  2638. '             ZVerifyNumeric     Verify that is a valid integer
  2639. '                                  if false, then verifying that
  2640. '                                  a string is between 2 values
  2641. '             ZVerifyLow$     Lowest ok value of string
  2642. '             ZVerifyHigh$    Highest ok value of string
  2643. '
  2644. '  OUTPUTS -- ZOK             Whether passes verification
  2645. '             ZVerifyList$    Empties if ok
  2646. '             ZVerifying      Sets false if ok
  2647. '             ZVerifyNumeric  Sets false if ok
  2648. '
  2649. '  PURPOSE -- Processes edits on a user input
  2650. '
  2651.       SUB VerifyAns STATIC
  2652.       ZOK = ZTrue
  2653.       IF NOT ZVerifying THEN _
  2654.          EXIT SUB
  2655.       Temp$ = ZUserIn$(1)
  2656.       CALL AllCaps (Temp$)
  2657.       IF ZVerifyList$ <> "" THEN _
  2658.          WasX$ = LEFT$(ZVerifyList$,1) : _
  2659.          ZOK = (INSTR (ZVerifyList$, WasX$+Temp$+WasX$) > 0) _
  2660.       ELSE IF ZVerifyNumeric THEN _
  2661.               CALL CheckInt (ZUserIn$) : _
  2662.               ZOK = (ZErrCode = 0 AND _
  2663.                     ZTestedIntValue >= VAL(ZVerifyLow$) AND _
  2664.                     ZTestedIntValue <= VAL(ZVerifyHigh$)) _
  2665.            ELSE ZOK = (Temp$ >= ZVerifyLow$ AND Temp$ <= ZVerifyHigh$)
  2666.       IF ZOK THEN _
  2667.          ZVerifyList$ = "" : _
  2668.          ZVerifying = ZFalse : _
  2669.          ZVerifyNumeric = ZFalse
  2670.       END SUB
  2671. 63520 ' $SUBTITLE: 'BinSearch - binary search a file'
  2672. ' $PAGE
  2673. '
  2674. '  NAME    -- BinSearch
  2675. '                                  MEANING
  2676. '  INPUTS  -- PassedSearchFor$  Value you are looking for
  2677. '             StartPos          Starting position of sort key
  2678. '             NumChars          # of characters in sort key
  2679. '             LenRec            Length of record of data file searching
  2680. '             High              Record # of last record
  2681. '             ZFastTabs$        In a binary integer subfield (2 bytes)
  2682. '                                  holds 1st record when might find
  2683. '                                  a key beginning with a particular
  2684. '                                  character (0-9,A-Z).   Empty if
  2685. '                                  no Fast Tab exists for the file.
  2686. '
  2687. '  OUTPUTS -- RecFoundAt        Record # value found at (0 if none)
  2688. '             RecFound$         Full data record when found
  2689. '
  2690. '  PURPOSE -- Binary searches work file #2 for a key value in a
  2691. '             data file that is sorted on a key field
  2692. '
  2693.       SUB BinSearch (PassedSearchFor$,StartPos, NumChars, LenRec, High, RecFoundAt, RecFound$) STATIC
  2694.       SearchFor$ = LEFT$(PassedSearchFor$,NumChars)
  2695.       SearchFor$ = SearchFor$ + SPACE$(NumChars-LEN(SearchFor$))
  2696.       FIELD #2, LenRec AS SearchRec$
  2697.       Low = 0
  2698.       IF LEN(ZFastTabs$) < 72 THEN _
  2699.          GOTO 63522
  2700.       WasX$ = LEFT$(SearchFor$,1)
  2701.       WasX = INSTR("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",WasX$)
  2702.       IF WasX > 0 THEN _
  2703.          Low = CVI(MID$(ZFastTabs$,1+2*(WasX-1),2)) - 1 : _
  2704.          IF WasX < 36 THEN _
  2705.             High = CVI(MID$(ZFastTabs$,1+2*WasX,2))
  2706. 63522 RecFoundAt = 0
  2707.       IF High < 1 THEN _
  2708.          EXIT SUB
  2709.       WasX$ = SPACE$ (NumChars)
  2710.       Done = ZFalse
  2711.       WHILE NOT Done
  2712.          WasI = INT(((High/2) + (Low/2)) + .5)
  2713.          GET 2, WasI
  2714.          LSET WasX$ = MID$(SearchRec$, StartPos, NumChars)
  2715.          IF WasX$ = SearchFor$ THEN _
  2716.             RecFound$ = SearchRec$: _
  2717.             RecFoundAt = WasI : _
  2718.             Done = ZTrue _
  2719.          ELSE IF (High - Low) < 2 THEN _
  2720.                  Done = ZTrue _
  2721.               ELSE IF WasX$ < SearchFor$ THEN _
  2722.                       Low = WasI _
  2723.                    ELSE IF WasX$ > SearchFor$ THEN _
  2724.                            High = WasI
  2725.       WEND
  2726.       END SUB
  2727. 63530 ' Take modem offhook
  2728.       SUB TakeOffHook STATIC
  2729.       CALL ModemPut (ZModemGoOffHookCmd$)
  2730.       CALL DelayTime (3)
  2731.       END SUB
  2732. 63540 ' Match Name to one in message file
  2733.       SUB ChkMsgName (MsgFromCaller,MsgToCaller) STATIC
  2734.       IF NOT ZRemoteSysop THEN _
  2735.          WasX$ = LEFT$("SYSOP",-5*ZSysop) : _
  2736.          CALL MsgNameMatch (ZOrigUserName$,WasX$,6,MsgFromCaller) : _
  2737.          CALL MsgNameMatch (ZOrigUserName$,WasX$,37,MsgToCaller) : _
  2738.          EXIT SUB
  2739.       CALL MsgNameMatch ("SYSOP",ZSysopFullName$,6,MsgFromCaller)
  2740.       IF NOT MsgFromCaller THEN _
  2741.          CALL MsgNameMatch (ZOrigUserName$,"",6,MsgFromCaller)
  2742.       CALL MsgNameMatch ("SYSOP",ZSysopFullName$,37,MsgToCaller)
  2743.       IF NOT MsgToCaller THEN _
  2744.          CALL MsgNameMatch (ZOrigUserName$,"",37,MsgToCaller)
  2745.       END SUB
  2746.       SUB MsgNameMatch (PrimeName$,AltName$,SearchPos,Found) STATIC
  2747.       WasX$ = LEFT$(PrimeName$+"  ",22-8*(SearchPos < 7))
  2748.       GOSUB 63542
  2749.       IF Found OR AltName$ = "" THEN _
  2750.          EXIT SUB
  2751.       WasX$ = LEFT$(AltName$ + "  ",22-8*(SearchPos < 7))
  2752.       GOSUB 63542
  2753.       EXIT SUB
  2754. 63542 WasY$ = MID$(ZMsgRec$,SearchPos,LEN(WasX$))
  2755.       ZWasDF = INSTR(WasY$,"@")
  2756.       IF ZWasDF > 0 THEN _
  2757.          MID$(WasY$,ZWasDF) = "      "
  2758.       Found = (WasY$ = WasX$)
  2759.       RETURN
  2760.       END SUB
  2761. 63570 ' Check Proposed Change to Time Remaining
  2762.       SUB ChkAddedTime (TimeToAdd) STATIC
  2763.       IF TimeToAdd <= 0 THEN _
  2764.          EXIT SUB
  2765.       IF ZTimeToDropToDos! = 0 OR ZOldDate$ = DATE$ THEN _
  2766.          GOTO 63571
  2767.       CALL CheckTime (ZTimeToDropToDos!, HowMuchTimeLeft!, 1)
  2768.       IF HowMuchTimeLeft! < -60 THEN _
  2769.          HowMuchTimeLeft! = (HowMuchTimeLeft! * -1) + 43200
  2770.       IF (ZSecsPerSession! - ZSecsUsedSession!) > HowMuchTimeLeft! THEN _
  2771.          TimeToAdd = INT(HowMuchTimeLeft! / 60) : _
  2772.          ZOutTxt$ = "Scheduled" : _
  2773.          GOSUB 63572
  2774. 63571 CheckTheTime = ZMinsPerSession + TimeToAdd
  2775.       IF ZLimitMinsPerSession THEN _
  2776.          IF CheckTheTime > ZLimitMinsPerSession THEN _
  2777.             TimeToAdd = ZLimitMinsPerSession - ZMinsPerSession : _
  2778.             ZOutTxt$ = "External" : _
  2779.             GOSUB 63572
  2780.       EXIT SUB
  2781. 63572 ZOutTxt$ = "Extension reduced to"+ STR$(TimeToAdd) + _
  2782.                  " due to " + ZOutTxt$ + " Event" : _
  2783.       CALL RingCaller
  2784.       END SUB
  2785. 63580 ' Displays user record
  2786.       SUB DispUserRec (ToPrint) STATIC
  2787.          ZOK = ZFalse
  2788.          WasX$ = MID$(ZUserRecord$,ZStartHash,ZLenHash)
  2789.          IF ASC(WasX$) = 0 OR LEFT$(WasX$,3) = "   " THEN _
  2790.             EXIT SUB
  2791.          WasOF = CVI(ZSecLevel$)
  2792.          IF WasOF > ZUserSecLevel THEN _
  2793.             IF NOT ZGlobalSysop THEN _
  2794.                EXIT SUB
  2795.          ZOutTxt$ = ZFG4$ + RIGHT$("     " + STR$(LOC(5)),4) + _
  2796.               ":" + _
  2797.               ZFG1$ + ZUserName$ + _
  2798.               ZFG2$ + "SECURITY" + _
  2799.               RIGHT$("     " + STR$(WasOF),5) + _
  2800.               " "
  2801.          ZOutTxt$ = ZOutTxt$ + _
  2802.               ZFG3$ + "Password = " + _
  2803.               ZPswd$ + ZEmphasizeOff$
  2804.          GOSUB 63583
  2805.          IF WasOF < ZOrigMainSec THEN _
  2806.             ZOutTxt$ = ZEmphasizeOn$ + "<Locked out>" + ZEmphasizeOff$ + SPACE$(7) _
  2807.          ELSE IF WasOF >= ZSysopSecLevel THEN _
  2808.             ZOutTxt$ = ZEmphasizeOn$ + "  (SYSOP)  " + ZEmphasizeOff$ + SPACE$(8) _
  2809.          ELSE ZOutTxt$ = SPACE$(19)
  2810.          ZOutTxt$ = ZOutTxt$ + _
  2811.               ZLastDateTimeOn$ + _
  2812.              "   " + _
  2813.              ZFG4$ + ZCityState$ + ZEmphasizeOff$
  2814.          GOSUB 63583
  2815.          ZOutTxt$ = "  DOWNLOADS = " + _
  2816.              RIGHT$("     " + STR$(CVI(ZUserDnlds$)),5) + _
  2817.              "   " + _
  2818.              "UPLOADS = " + _
  2819.              RIGHT$("     " + STR$(CVI(ZUserUplds$)),5) + _
  2820.              "   " + _
  2821.              " Times on ="
  2822.           ZOutTxt$ = ZOutTxt$ + RIGHT$("     " + STR$(CVI(MID$(ZUserOption$,1,2))),5) + _
  2823.              "   " + _
  2824.              "TIME USED = " + _
  2825.              RIGHT$("    " + STR$(CVI(ZElapsedTime$)),4) + _
  2826.              " Min"
  2827.          GOSUB 63583
  2828.          IF NOT ZEnforceRatios THEN _
  2829.             GOTO 63581
  2830.          ZOutTxt$ = "BYTES: Dwn=" + STR$(CVS(ZDlBytes$)) + _
  2831.               "  Up=" + STR$(CVS(ZULBytes$)) + _
  2832.               " TODAY Dwn: #=" + STR$(CVS(ZTodayDl$)) + _
  2833.               " Bytes=" + STR$(CVS(ZTodayBytes$))
  2834.          GOSUB 63583
  2835. 63581   IF (ZStartIndiv = 0 OR ZLenIndiv = 0) AND _
  2836.            (ZStartHash = 0 OR ZLenHash = 0) AND _
  2837.            NOT ZRestrictByDate THEN _
  2838.               GOTO 63582
  2839.         IF (ZStartHash > 1 AND ZLenHash > 0) THEN _
  2840.            ZOutTxt$ = "Hash: " + MID$(ZUserRecord$,ZStartHash,ZLenHash) _
  2841.         ELSE ZOutTxt$ = ""
  2842.         IF (ZStartIndiv > 1 AND ZLenIndiv > 0) THEN _
  2843.            ZOutTxt$ = ZOutTxt$ + " Indiv: " + MID$(ZUserRecord$,ZStartIndiv,ZLenIndiv)
  2844.         IF ZRestrictByDate THEN _
  2845.             CALL SetRegDisplay : _
  2846.             ZOutTxt$ = ZOutTxt$ + "  Registered: " + _
  2847.                        ZRegDisplayDate$
  2848.         GOSUB 63583
  2849. 63582   ZOK = ZTrue
  2850.         EXIT SUB
  2851. 63583   IF ToPrint THEN _
  2852.             CALL Printit (ZOutTxt$)
  2853.         CALL QuickTPut1 (ZOutTxt$)
  2854.         RETURN
  2855.         END SUB
  2856. 63585 '  *  CALCULATE REGISTRATION DATES
  2857.         ' checks proposed new registration date
  2858.         SUB ResetRegDate (WorkDate$) STATIC ' Formerly 11470
  2859.         IF LEN(WorkDate$) < 10 THEN _
  2860.            WorkDate$ = LEFT$(WorkDate$,6) + _
  2861.                         "19" + _
  2862.                         RIGHT$(WorkDate$,2)
  2863.         ZTodayRegYY = VAL(MID$(WorkDate$,7))
  2864.         ZTodayRegMM = VAL(LEFT$(WorkDate$,2))
  2865.         ZTodayRegDD = VAL(MID$(WorkDate$,4,2))
  2866.         ZOK = ZTodayRegYY > 1979 AND ZTodayRegMM > 0 AND _
  2867.               ZTodayRegMM < 13 AND ZTodayRegDD > 0 AND _
  2868.               ZTodayRegDD < 32
  2869.         IF ZOK THEN _
  2870.            CALL TwoByteDate (ZTodayRegYY,ZTodayRegMM,ZTodayRegDD,ZRegDate$)
  2871.         END SUB
  2872.         ' Sets display of registration date
  2873.         SUB SetRegDisplay STATIC  ' Formerly 11480
  2874.         WasX$ = MID$(ZUserOption$,11,2)
  2875.         IF CVI(WasX$) <> 0 THEN _
  2876.            ZRegDate$ = WasX$ : _
  2877.         ELSE CALL RegToCurrent
  2878.         CALL UnPackDate (ZRegDate$,ZUserRegYY,ZUserRegMM,ZUserRegDD,ZRegDisplayDate$)
  2879.         IF CVI(WasX$) = 0 THEN _
  2880.            ZRegDisplayDate$ = "00-00-00"
  2881.         END SUB
  2882.         ' Sets registration date to current date
  2883.         SUB RegToCurrent STATIC    ' Formerly 11482
  2884.         WorkDate$ = DATE$
  2885.         CALL ResetRegDate (WorkDate$)
  2886.         END SUB
  2887. 63625 ' * Sets SysOp security variables Formerly 5370 of rbbs-pc.bas
  2888.       ' * Returns ZWasA true when remote or global sysop
  2889.       SUB SetSysOp STATIC
  2890.       ZRemoteSysop = (ZActiveUserName$ = ZSysopPswd1$ + " " + ZSysopPswd2$)
  2891.       ZWasA = ZRemoteSysop
  2892.       ZGlobalSysop = (ZGlobalSysop OR (ZWasA AND ZOrigCnfg$ = ZConfigFileName$))
  2893.       IF ZGlobalSysop THEN _
  2894.          ZWasA = ZTrue
  2895.       END SUB
  2896. 63630 ' * Sets the user preferences based on user record.
  2897.       ' * Formerly in RBBS-PC.BAS
  2898.       SUB SetUserPref STATIC
  2899.       IF ZWasA THEN _
  2900.          ZUserSecLevel = ZSysopSecLevel _
  2901.       ELSE ZUserSecLevel = CVI(ZSecLevel$)
  2902.       ZLastMsgRead = CVI(MID$(ZUserOption$,3,2))
  2903.       ZUserXferDefault$ = MID$(ZUserOption$,5,1)
  2904.       IF ZUserXferDefault$ = " " THEN _
  2905.          ZUserXferDefault$ = "N"
  2906.       CALL XferType (2,ZTrue)
  2907.       WasX = ASC(MID$(ZUserOption$,6,1))
  2908.       ZWasGR = (WasX MOD 3)
  2909.       ZBoldText$ = CHR$(48 - (WasX > 50))
  2910.       ZUserTextColor = (WasX - ZWasGR)/3 + 21
  2911.       IF ZUserTextColor > 37 THEN _
  2912.          ZUserTextColor = ZUserTextColor - 7
  2913.       IF ZEmphasizeOff$ <> "" THEN _
  2914.          CALL QuickTPut (ZColorReset$,0)
  2915.       IF ZEmphasizeOnDef$ <> "" THEN _
  2916.          ZEmphasizeOff$ = ZEscape$ + "[" + ZBoldText$ + ";40;" + MID$(STR$(ZUserTextColor),2) + "m" _
  2917.       ELSE ZEmphasizeOff$ = ""
  2918.       IF ZWasGR = 1 AND NOT ZEightBit THEN _
  2919.          ZWasGR = 0
  2920.       CALL SetGraphic (ZWasGR,ZUserGraphicDefault$)
  2921.       ZRightMargin = CVI(MID$(ZUserOption$,7,2))
  2922.       IF ZRightMargin > 72 THEN _
  2923.          ZRightMargin = 72
  2924.       ZWasCI$ = ZCityState$
  2925.       CALL Trim (ZWasCI$)
  2926.       UserOptions = CVI(MID$(ZUserOption$,9,2))
  2927.       ZPromptBell = (UserOptions AND 1) > 0
  2928.       ZExpertUser = (UserOptions AND 2) > 0
  2929.       CALL SetExpert
  2930.       ZNulls = (UserOptions AND 4) > 0
  2931.       ZUpperCase = (UserOptions AND 8) > 0
  2932.       ZLineFeeds = (UserOptions AND 16) > 0
  2933.       ZCheckBulletLogon = (UserOptions AND 32) > 0
  2934.       ZSkipFilesLogon = (UserOptions AND 64) > 0
  2935.       ZAutoDownDesired = (UserOptions AND 128) > 0
  2936.       ZReqQuesAnswered = (UserOptions AND 256) > 0
  2937.       ZMailWaiting = (UserOptions AND 512) > 0
  2938.       WasX = (UserOptions AND 1024 ) > 0
  2939.       CALL SetHiLite (NOT WasX)
  2940.       IF NOT ZHiLiteOff THEN _
  2941.          CALL QuickTPut (ZEmphasizeOff$,0)
  2942.       ZTurboKeyUser = (UserOptions AND 2048) > 0
  2943.       ZTurboKey = ZFalse
  2944.       CALL SetRegDisplay
  2945.       ZPageLength = ASC(MID$(ZUserOption$,13,1))
  2946.       IF ZSubBoard THEN _
  2947.          GOTO 63632
  2948.       WasX$ = ZEchoer$
  2949.       ZEchoer$ = MID$(ZUserOption$,14,1)
  2950.       IF INSTR("ICR",ZEchoer$) = 0 THEN _
  2951.          ZEchoer$ = "R"
  2952.       IF WasX$ <> ZEchoer$ THEN _
  2953.          CALL ReportEcho
  2954.       CALL SetEcho (ZEchoer$)
  2955. 63632 ZNul$ = MID$(STRING$(5,0),1, - 5 * ZNulls)
  2956.       CALL SetCrLf
  2957.       ZUseTPut = (ZUpperCase OR ZXOnXOff)
  2958.       ZPswdSave$ = ZPswd$
  2959.       END SUB
  2960. 63635 ' * Reports who is doing echoing.  Formerly 9525 of rbbs-pc.bas
  2961.       SUB ReportEcho STATIC
  2962.       IF ZEchoer$ = "R" THEN _
  2963.          ZOutTxt$ =  "RBBS now set" _
  2964.       ELSE IF ZEchoer$ = "C" THEN _
  2965.               ZOutTxt$ = "Please set your communications package" _
  2966.            ELSE ZOutTxt$ = "Intermediate host now set"
  2967.       CALL QuickTPut1 (ZOutTxt$ + " to echo what you type")
  2968.       END SUB
  2969. 63675 SUB SetUserUpDn STATIC
  2970.       ZDnlds = CVI(ZUserDnlds$)
  2971.       ZUplds = CVI(ZUserUplds$)
  2972.       IF ZEnforceRatios THEN _
  2973.          ZDLToday! = CVS(ZTodayDl$) : _
  2974.          ZBytesToday! = CVS(ZTodayBytes$) : _
  2975.          ZDLBytes! = CVS(ZDlBytes$) : _
  2976.          ZULBytes! = CVS(ZULBytes$)
  2977.       END SUB
  2978.       SUB SetGlobalUpDn STATIC
  2979.       IF NOT ZGlobalsSet THEN _
  2980.          ZGlobalsSet = ZTrue : _
  2981.          ZGlobalDnlds = ZDnlds : _
  2982.          ZGlobalUplds = ZUplds : _
  2983.          ZGlobalDLToday! = ZDLToday! : _
  2984.          ZGlobalBytesToday! = ZBytesToday! : _
  2985.          ZGlobalDLBytes! = ZDLBytes! : _
  2986.          ZGlobalULBytes! = ZULBytes!
  2987.       END SUB
  2988. 63715 ' Counts the number of words NumFound in ParseThis, defined
  2989.       ' as strings separated by those in ExcludeThis$
  2990.       '
  2991.       SUB ExcludeCount (ExcludeThis$, ParseThis$, NumFound) STATIC
  2992.       NumFound = 0
  2993.       StartAt = 1
  2994.       FOR I = 1 TO LEN(ParseThis$)
  2995.          IF INSTR(ExcludeThis$, MID$(ParseThis$, I, 1)) > 0 THEN _
  2996.             ParseLen = I - StartAt : _
  2997.             IF ParseLen > 0 THEN _
  2998.                NumFound = NumFound + 1
  2999.       NEXT
  3000.       END SUB
  3001. 63720 SUB AraAllCaps (Ara$(1),WhichElement) STATIC
  3002.       Temp$ = Ara$(WhichElement)
  3003.       CALL AllCaps (Temp$)
  3004.       Ara$(WhichElement) = Temp$
  3005.       END SUB
  3006.